;;; --------------------------------------------------------------------------- ;;; PolyTo3D.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; LIFT A FLAT POLYLINE INTO THREE DIMENSIONS ;;; ;;; PURPOSE ;;; Converts a flat polyline into a 3D polyline, so its vertices can be given ;;; individual heights. ;;; ;;; A contour traced flat can be lifted to its level. A drainage run can be ;;; given falls. A road centreline can take a vertical alignment. None of that ;;; is possible while it is a lightweight polyline, which has one elevation for ;;; the whole object and no way to vary it. ;;; ;;; Heights can come from the polyline's own elevation, from a level you type, ;;; or by picking each vertex in turn. ;;; ;;; POLYFLAT goes the other way, dropping a 3D polyline back to one level. ;;; ;;; WHY AUTOCAD WILL NOT DO IT ;;; There is no command for this. A lightweight polyline and a 3D polyline are ;;; different object types with different structures - the first stores 2D ;;; points and one elevation, the second stores a chain of 3D vertices. One ;;; cannot become the other; a new object has to be built from the old one's ;;; points, which is what this does. ;;; ;;; Bulges are lost in the conversion, because a 3D polyline has no arcs. Any ;;; curved segment is reported and drawn as a straight chord. ;;; ;;; WHAT WAS FIXED ;;; The original could not work. Its main loop was ;;; ;;; (setq k (+ (cdr (assoc 70 ent1)) 8)) ;;; (while (/= k "SEQEND") ...) ;;; ;;; K is set to a NUMBER and then compared against a STRING on every pass. The ;;; two are never equal, so the loop could only end by running off the end of ;;; the entity chain and failing on (entget nil). ;;; ;;; It also called ENTMAKE and then ENTMOD on the object it had just made, over ;;; and over, trying to correct fields after the fact; carried its state in ;;; seven global variables set up by a separate framework of helper functions; ;;; and finished with (command ".MOVE" (entlast) "" "@" "@" ".REDRAW") - a move ;;; of zero distance with a REDRAW passed as one of its arguments. ;;; ;;; POLY3D - lift a flat polyline into 3D ;;; POLYFLAT - drop a 3D polyline back to one level ;;; --------------------------------------------------------------------------- (vl-load-com) (defun P3D:Layer ( data ) (cond ((cdr (assoc 8 data))) (t (getvar "CLAYER"))) ) ;;; Everything worth carrying from the old object to the new one. (defun P3D:Props ( data / out ) (foreach code '(8 6 62 370 48) (if (assoc code data) (setq out (cons (assoc code data) out)))) (reverse out) ) ;;; The vertices of any polyline as a list of 3D points, and whether any segment ;;; was curved. (defun P3D:Points ( ent / data kind pts elev sub bulged ) (setq data (entget ent) kind (cdr (assoc 0 data)) elev (cond ((cdr (assoc 38 data))) (t 0.0)) pts nil bulged nil) (cond ((= kind "LWPOLYLINE") (foreach pair data (cond ((= 10 (car pair)) (setq pts (cons (list (cadr pair) (caddr pair) elev) pts))) ((and (= 42 (car pair)) (not (zerop (cdr pair)))) (setq bulged t))))) ((= kind "POLYLINE") (setq sub (entnext ent)) (while (and sub (/= "SEQEND" (cdr (assoc 0 (entget sub))))) (if (= "VERTEX" (cdr (assoc 0 (entget sub)))) (progn (setq pts (cons (cdr (assoc 10 (entget sub))) pts)) (if (not (zerop (cond ((cdr (assoc 42 (entget sub)))) (t 0.0)))) (setq bulged t)))) (setq sub (entnext sub))))) (list (reverse pts) bulged) ) (defun P3D:Make3d ( pts layer props ) (entmake (append (list '(0 . "POLYLINE") (cons 8 layer) '(66 . 1) '(70 . 8) '(10 0.0 0.0 0.0)) props)) (foreach p pts (entmake (list '(0 . "VERTEX") (cons 8 layer) (cons 10 p) '(70 . 32)))) (entmake (list '(0 . "SEQEND") (cons 8 layer))) ) (defun P3D:Make2d ( pts layer props elev ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 0) (cons 38 elev)) (mapcar '(lambda ( p ) (cons 10 (list (car p) (cadr p)))) pts) props)) ) ;;; --------------------------------------------------------------------------- ;;; POLY3D ;;; --------------------------------------------------------------------------- (defun c:POLY3D ( / *error* vars vals sel ent data kind result pts bulged how lay props z i p n curved ) (setq vars '("CMDECHO" "OSMODE") vals (mapcar 'getvar vars)) (defun P3D:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (P3D:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** POLY3D error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (setq ent nil) (while (and (null ent) (setq sel (entsel "\nFlat polyline to lift : "))) (setq kind (cdr (assoc 0 (entget (car sel))))) (cond ((= kind "LWPOLYLINE") (setq ent (car sel))) ((and (= kind "POLYLINE") (zerop (logand 8 (cdr (assoc 70 (entget (car sel))))))) (setq ent (car sel))) ((= kind "POLYLINE") (princ "\n That is already a 3D polyline.")) (t (princ (strcat "\n A " kind " is not a polyline."))))) (if (null ent) (princ "\nCancelled.") (progn (setq data (entget ent) result (P3D:Points ent) pts (car result) curved (cadr result) lay (P3D:Layer data) props (P3D:Props data) n (length pts)) (if (< n 2) (princ "\n** That polyline has fewer than two vertices. **") (progn (initget "Keep Level Pick") (setq how (getkword "\nHeights from [Keep/Level/Pick] : ")) (if (null how) (setq how "Keep")) (cond ((= how "Level") (initget 1) (setq z (getreal "\n Level for every vertex: ")) (setq pts (mapcar '(lambda ( p ) (list (car p) (cadr p) z)) pts))) ((= how "Pick") (setq i 1 p nil) (setq pts (mapcar '(lambda ( q ) (initget 1) (setq z (getreal (strcat "\n Level at vertex " (itoa i) " of " (itoa n) ": ")) i (1+ i)) (list (car q) (cadr q) z)) pts)))) (P3D:Make3d pts lay props) (entdel ent) (princ (strcat "\n" (itoa n) " vertices lifted to a 3D polyline.")) (if curved (princ (strcat "\n ** Curved segments were straightened -" " a 3D polyline cannot hold an arc. **"))))))) (P3D:Restore) (princ) ) ;;; --------------------------------------------------------------------------- ;;; POLYFLAT ;;; --------------------------------------------------------------------------- (defun c:POLYFLAT ( / *error* vars vals sel ent data result pts lay props z n ) (setq vars '("CMDECHO") vals (mapcar 'getvar vars)) (defun P3D:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (P3D:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** POLYFLAT error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (setq ent nil) (while (and (null ent) (setq sel (entsel "\n3D polyline to flatten : "))) (setq data (entget (car sel))) (if (and (= "POLYLINE" (cdr (assoc 0 data))) (= 8 (logand 8 (cdr (assoc 70 data))))) (setq ent (car sel)) (princ "\n That is not a 3D polyline."))) (if (null ent) (princ "\nCancelled.") (progn (setq data (entget ent) result (P3D:Points ent) pts (car result) lay (P3D:Layer data) props (P3D:Props data) n (length pts)) (initget 1) (setq z (getreal "\nLevel to flatten it to <0>: ")) (if (null z) (setq z 0.0)) (P3D:Make2d pts lay props z) (entdel ent) (princ (strcat "\n" (itoa n) " vertices flattened to level " (rtos z 2 3) ".")))) (P3D:Restore) (princ) ) (princ)