Z坐标，移动所有对象
大家好，我又回来需要帮助了，我有一个“挑战”（问题！呵呵…）这包括获取在特定坐标Z（平面）上的每个对象，我需要将该平面的每个项目移动到Z=0，但是，我有200个计划，每个计划有6个对象，移动到Z=0，它将是一个在另一个之上，有必要将其在坐标X中移动一个特定的空间（需要填充一个项目）。
如果有人知道Lisp程序可以帮助我，我将不胜感激！。。。
提前感谢！ 我发现了一些可以帮助我的东西，但有人知道如何让同一平面上的所有物体一起移动吗？完成代码就是这样的缺失！
提前谢谢！！！。。。 我找到的代码。。。所以在X位置移动不起作用。。。它工作得很好，但是，实体是重叠的！。。。在红色中，我用一种简单的方法移动物体。。。逐级。。。正在修改5000值。。。我可以按级别或用户填写的输入数字递增。
如果有人能帮我。。。提前感谢。。。
; 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)
)
(command "_move" ss "" '(0.0 0.0 0.0) (cons 5000 '(0.0 0.0))) ; TEST
(*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 " ")
(*end*)
)
(t (princ "\nNothing selected."))
)
; terminate
(princ)
) CafeJr，请备份您的DWG并尝试一下，看看它是否适合您的需要。。。
(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>: "))
(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)
)
M.R。
哇。。。你做得最努力。。。在新图形中分离切片。。。是它，马科，正在工作！。。。再次感谢！。。。但是，有可能得到切片并将其放在同一个模型空间的Z=0？。。。按标高原点间距？。。。Z=10上的对象，转到X=0和Z=0，下一个级别Z=20转到X=5000和Z=0，下一个级别Z=30转到X=1000和Z=0。。。直到所有级别都完成？。。。 我决定用所有sel的DX值来隔开它们。添加了间距的实体集。。。当要求分散时，您是否尝试过“是”选项？
顺便说一句，我对代码做了更多修改，以检查实体是否为2D，如果不是，则程序退出，如果实体与WCS不并行，也会退出。。。
M、 R。 好的，再次感谢Marko！。。。就是这样！。。。我看到你使用一个外部引用将它们并排放置，我在同一个模型空间中使用它来处理它，需要得到实体，分解，剪切，还有很多其他的事情要做。。。在这种情况下，我需要使用一个参照编辑，从外部参照中减去（参照集-从工作集中删除），所有这些都可以工作，可以用另一种方式吗？所以，即使这样，你也为我节省了很多编写代码和避免错误的时间！！！。。。我真的很感激你！！！。。。 使用外部参照生成新文件后，只需执行XREF命令，选择所有外部参照并将其绑定。。。如果你想松散层信息，这是使它像在原版。DWG，绑定时，使用插入选项，然后在创建的块上分解。。。但如果要保留从外部参照获得的层前缀，例如（dwgname-0.00000000$0$Layer1），则应使用绑定选项，然后分解从外部参照创建的块。。。当然，在这两种情况下，0层都将保持为0，因此强烈建议创建新层并在其上放置实体（c:elevs2xrefs）。。。
M、 R。
大师Marko！。。。非常感谢。我在测试它，效果和我预期的一样好！！！。。。顺便提一下，是否可以在外部参照顶部插入一个文本，如“Z=位置”？我有一个疑问，插入一个空格来分散（例如=5000）它在8633.2363上间隔切片。看代码，我没有发现为什么会这样，我看到有一个“+dx间隙”可能是“dx”？
页:
[1]