[编程交流] Z坐标，移动所有对象

    ; 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 (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
   ss (ssget)
    )
[color=red](command "_move" ss "" '(0.0 0.0 0.0) (cons 5000 '(0.0 0.0))) ; TEST[/color]     
    (*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)
)

(defun c:elevs2xrefs ( / *error* fildia dwgn dwgname ss i ent entlst path loop bb se dx ch gap p )
 (defun *error* ( msg )
   (if fildia (setvar 'filedia fildia))
   (if msg (prompt msg))
   (princ)
 )
 (vl-load-com)
 (alert "\nAll enities in current MODEL space in DWG must be 2d and parallel to WCS - ENTER TO CONTINE else ESC to terminate")
 (setq fildia (getvar 'filedia))
 (setvar 'tilemode 1)
 (setq dwgn (getvar 'dwgname))
 (setq dwgname (substr dwgn 1 (- (strlen dwgn) 4)))
 (setq ss (ssget "_X" '((410 . "Model"))))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entlst (cons ent entlst))
 )
 (if (not (vl-every '(lambda ( x ) (or (equal (assoc 210 x) '(210 0.0 0.0 1.0)) (equal (assoc 12 x) '(12 0.0 0.0 1.0)))) (mapcar 'entget entlst)))
   (progn
     (alert "\nNot all enities are parallel to WCS - quitting...")
     (exit)
   )
 )
 (if (not (vl-every '(lambda ( x ) (equal (caddr (car x)) (caddr (cadr x)) 1e-6)) (mapcar 'acet-ent-geomextents entlst)))
   (progn
     (alert "\nNot all enities are 2D - quitting...")
     (exit)
   )
 )
 (setvar 'filedia 0)
 (vla-save (vla-get-activedocument (vlax-get-acad-object)))
 (setq path (vl-catch-all-apply 'vl-filename-directory (list (getfiled "Select destination directory for dwg split export - pick one file in desired folder" "" "" 4))))
 (command "_.-layer" "on" "*" "t" "*" "u" "*" "")
 (command "_.ucs" "w")
 (command "_.ucs" "front")
 (command "_.plan" "")
 (command "_.zoom" "0.5xp")
 (setq loop t)
 (while loop
   (setq bb (acet-geom-ss-extents-accurate ss))
   (setq se (ssget "_F" (list (list (caar bb) (cadar bb)) (list (caadr bb) (cadar bb)))))
   (command "_.ucs" "w")
   (command "_.-wblock" (strcat path "\" dwgname "-" (rtos (cadar bb)) ".dwg") "" (list 0.0 0.0 (cadar bb)) se "")
   (command "_.erase" se "")
   (command "_.-xref" "A" (strcat path "\" dwgname "-" (rtos (cadar bb)) ".dwg") (list 0.0 0.0 (cadar bb)) "" "" "")
   (command "_.ucs" "p")
   (setq ss (acet-ss-remove se ss))
   (if (equal (cadar bb) (cadadr bb) 1e- (setq loop nil))
 )
 (command "_.saveas" "" (strcat path "\" dwgname "-allelevs.dwg"))
 (command "_.ucs" "w")
 (command "_.plan" "")
 (command "_.zoom" "0.5xp")
 (setq ss (ssget "_X" '((410 . "Model"))))
 (setq bb (acet-geom-ss-extents-accurate ss))
 (setq dx (- (caadr bb) (caar bb)))
 (initget "Yes No")
 (setq ch (getkword "\nScatter created XREFS along X axis on elevation 0.0 [Yes/No] <Yes>: "))
 (if (or (eq ch "Yes") (eq ch nil))
   (progn
     (setq gap (abs (getdist "\nSpecify gap distance between 2 Xrefs along X axis: ")))
     (setq i -1)
     (while (setq ent (ssname ss (setq i (1+ i))))
       (vla-move (vlax-ename->vla-object ent) (vlax-3d-point (setq p (cdr (assoc 10 (entget ent))))) (vlax-3d-point (list (car p) (cadr p) 0.0)))
       (vla-move (vlax-ename->vla-object ent) (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list (* (float i) (+ dx gap)) 0.0 0.0)))
     )
     (command "_.saveas" "" (strcat path "\" dwgname "-allelevsscatter.dwg"))
   )
 )
 (*error* nil)
 (princ)
)