Hi,
I tried to make a slim lisp for flattening, from different codes available on forums.
Can someone please help to give a look over it to see if it's something wrong and to slim it more and to add the code for:
- flattening REGION;
- changing OLE Z coordinate to zero.
I know that there are specific codes for specific entities but the lisp is small in this way.
Thank you.
(defun C:ZERO (/ zeroz ss1 ss1len i numchg
ename elist etype vrt crz
)
;Function to change Z coordinate to 0
(defun zeroz (key zelist / oplist nplist)
(setq oplist (assoc key zelist)
nplist (reverse (append '(0.0) (cdr (reverse oplist))))
zelist (subst nplist oplist zelist)
)
(entmod zelist)
)
;Initialization
(setvar "CMDECHO" 0) ;no prompts and inputs displayed on command line
(command ".UCS" "World") ;set World UCS
(command ".UNDO" "Group") ;start undo group
;Get input
(setq ss1 (ssget "X")) ;select all entities in database
;*initialize variables
(setq ss1len (sslength ss1) ;length of selection set
i 0 ;loop counter
numchg 0 ;number changed counter
) ;setq
;*do the work
(prompt "\nZERO Working ..")
(while (< i ss1len) ;while more members in the SS
(if (= 0 (rem i 500))
(prompt ".")
)
(setq ename (ssname ss1 i) ;entity name
elist (entget ename) ;entity data list
etype (cdr (assoc 0 elist)) ;entity type
)
;change each POLYLINE vertex Z coordinate to 0
;code provided by Vladimir Livshiz, 1998_10_09
(if (= etype "POLYLINE")
(progn
(setq vrt ename)
(while (not (equal (cdr (assoc 0 (entget vrt))) "SEQEND"))
(setq elist (entget (entnext vrt)))
(setq crz (cadddr (assoc 10 elist)))
(if (/= crz 0)
(progn
(zeroz 10 elist)
(entupd ename)
)
)
(setq vrt (cdr (assoc -1 elist)))
)
)
)
;special handling for LWPOLYLINE
;code provided by Mark Middlebrook
(if (= etype "LWPOLYLINE")
(progn
(setq elist (subst (cons 38 0.0) (assoc 38 elist) elist)
numchg (1+ numchg)
)
(entmod elist)
)
)
(setq i (1+ i)) ;next entity
)
;ZERO the rest
;code provided by Jonathan Handojo, 2022_02_23
(repeat (setq i (sslength ss1))
(entmod
(mapcar
(function
(lambda (a)
(if
(member (car a)
'(10 11 12 13 14 15 16 17 18
20 21 22 23 24 25 26 27 28
30 31 32 33 34 35 36 37)
)
(list (car a) (cadr a) (caddr a) 0.0)
a
)
)
)
(entget (ssname ss1 (setq i (1- i))))
)
)
)
(command "CHANGE" "ALL" "" "P" "T" 0 "")
(terpri)
(if (ssget "X" '((0 . "INSERT") (66 . 1)))(command "ATTSYNC" "N" "*"))
(command "REGEN")
(command ".UNDO" "End") ;end undo group
(terpri)
(prompt "\nZERO Done.")
(terpri)
(princ)
)
