[编程交流] 修复命令ZeroZ

                                ; ZeroZ.lsp
                                ;
                                ; Change Z coordinate of all selected entities to 0 (OCS)
                                ;
                                ; Copyright (c) 2000 Michael Puckett All Rights Reserved
                                ;
                                ; ==================================================?=====
(defun c:zeroz
       (/                        ; local functions (defuns)
        *error*        *begin*        *end* *zeroz* *children* ; local vars
        ss i ent ents)
                                ; local defun *error*
 (defun *error* (s)
   (*end*)
   (princ (strcat "Error: " s ".\n"))
   (princ)
 )
                                ; local defun *begin*
 (defun *begin* ()
   (setvar "cmdecho" 0)
   (while (eq 8 (logand 8 (getvar "undoctl")))
     (command ".undo" "_end")
   )
   (if        (zerop (logand 2 (getvar "undoctl")))
     (if (eq 1 (logand 1 (getvar "undoctl")))
(command ".undo" "_begin")
     )
   )
 )
                                ; local defun *end*
 (defun *end* ()
   (if        (eq 8 (logand 8 (getvar "undoctl")))
     (command ".undo" "_end")
   )
   (setvar "cmdecho" 1)
 )
                                ; local defun *zeroz*
 (defun *zeroz* (ent)
   (entmod
     (mapcar
'(lambda (x)
   (cond
     ((member (car x) '(10 11 12 13 14))
      (cons (car x) (list (cadr x) (caddr x) 0.0))
     )
     ((eq 38 (car x)) '(38 . 0.0))
     (t x)
   )
 )
(entget ent)
     )
   )
 )
                                ; local defun *children*
 (defun *children* (ent / d r)
   
;*------------------------------------
;(if (<= j 6)
 (command "_move" ent "" '(0.0 0.0 0.0) (cons n '(0.0 0.0)))
 (setq i (1+ j))
;  )
 (if (> j 6)
   ((setq n (+ 5000 n)
   j 1
    )
   )
 )
;  )                                        ; TESTE
 
;*-----------------------------------
   
   (if        (assoc 66 (entget ent))
     (reverse
(while
  (/= "SEQEND"
      (cdr (assoc 0 (setq d (entget (setq ent (entnext ent))))))
  )
   (setq r (cons (cdr (assoc -1 d)) r))
)
     )
   )
 )
                                ; main
 (cond
   ((setq i  -1
   j 1
   n 0
   ss (ssget)
    )
;--------------------
;( command "_.explode" all )
;(command "_explode" ent "")
;    (setq ent (entnext))
   
;  (setq pa (getvar "peditaccept"))
;  (setvar "peditaccept" 1)
;  (setq ent (entlast))
;  (command "pedit" "m" ent "" "j" "0.01" "")
;  (setvar "peditaccept" pa)
    
;         (repeat (sslength ss); TESTE
;            (setq ent (ssname ss (setq i (1+ i))));TESTE
    
    
;       (foreach x (setq ents (*children* ent)) (*zeroz* x));TESTE
;       (if ents;TESTE
;         (entupd ent);TESTE
;       );TESTE
    
;--------------------
    (*begin*)
    (princ "\nZeroing Z's for entity(s) ...")
    (repeat (sslength ss)
      (*zeroz* (setq ent (ssname ss (setq i (1+ i)))))
      (foreach x (setq ents (*children* ent)) (*zeroz* x))
      (if ents
 (entupd ent)
      )
                                ; in case a bazillion entities were selected
                                ; let the user know we have not died
      (if (zerop (rem i 100))
 (princ ".")
      )
    )
    (princ " [Done]")
    (*end*)
   )
   (t (princ "\nNothing selected."))
 )
                                ; terminate
 (princ)
)