I didn't like the name, so it is now SQUASH.
(defun c:SQUASH ( / *error* vars vals @Anonymous ss i n e0 e ent etyp squashed)
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* *
;* SQUASH.LSP by John F. Uhden *
;* 2 Village Road *
;* Sea Girt, NJ 08750 *
;* *
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;; Changes the Z value or 38 code to 0.0 for all objects, including
;; their subentities such as heavy vertices and attributes.
;; Locked layer checking removed.
; v1.0 (8-27-99)
; v15.00 (04-07-00) for R15
; v??.0 (8-31-2020) renamed from FlattenAll.lsp
(gc)
(vl-load-com)
(princ "Squash (c)1999-2020, John F. Uhden\n")
(princ "Adapted from Z0.lsp (c)1999-2000\n")
(defun *error* (error)
(mapcar 'setvar vars vals)
(vla-endundomark *doc*)
(cond
((not error))
((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
(1 (princ (strcat "\nERROR: " error)))
)
(princ)
)
(setq vars '(cmdecho))
(setq vals (mapcar 'getvar vars))
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(mapcar 'setvar vars '(0))
(command "_.expert" (getvar "expert")) ;; dummy command
;;--------------------------------------------------------------------
;; Function to dig into each entity or subentity and change either its
;; 10, 11, 12, 13, or 38 code to 0.0:
;;
(defun @Anonymous (ent / new)
(foreach item ent
(cond
((and (= (car item) 38)(/= (cdr item) 0.0))
(setq new (cons 38 0.0)
ent (subst new item ent)
)
)
((and (/= etyp "LWPOLYLINE")(vl-position (car item) '(10 11 12 13))
(not (atom (cdr item)))
(> (length item) 3)
(/= (last item) 0.0))
(setq new (reverse (cons 0.0 (cdr (reverse item))))
ent (subst new item ent)
)
)
)
)
(setq squashed (or squashed new))
(if new (entmod ent))
)
(setq i 0 N 0)
(vlax-for block (vlax-get *doc* 'blocks)
(vlax-for obj block
(prompt (strcat "\rProcessing # " (rtos (1+ i) 2 0)))
(setq e0 (vlax-vla-object->ename obj)
e e0
ent (entget e)
etyp (cdr (assoc 0 ent))
squashed nil
i (1+ i)
)
(if (assoc 66 ent)
(while (/= (cdr (assoc 0 ent)) "SEQEND")
(@squash ent)
(setq e (entnext e) ent (entget e))
)
(@squash ent)
)
(if squashed
(progn
(entupd e0)
(setq n (1+ n))
)
)
)
)
(prompt (strcat "\nSquashed " (rtos n 2 0) " objects to elevation 0."))
(*error* nil)
)
(defun c:SQ ()(c:Squash))
