循环浏览来自的图层名称
你好一、 我是Autolisp世界的新手。我想知道是否有人能帮我做一个项目。我有一个AutoCAD项目，其中各层相互堆叠。
我正在寻找lisp代码，该代码将循环通过选定对象的层名称，并将这些对象（层）分开，并排放置在35英寸的距离。
欢迎任何帮助。
谢谢 这应该给你一个开始：
(defun C:test ( / i cmd ld ln Layers SS SSS n )
(initget (+ 1 2))
(if (setq i (getint "\nSpecify spacing increment: "))
(progn
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(while (setq ld (tblnext "LAYER" (not ld)))
(and
(/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (setq ln (cdr (assoc 2 ld)))))))))
(setq Layers (cons ln Layers))
); and
); while
(foreach x Layers
(setq SS (ssget "_X" (list (cons 8 x))))
(setq SSS (cons SS SSS))
)
(foreach s SSS
(command "_.MOVE" s "" "_non" '(0. 0. 0.) "_non" (list 0. (setq n (cond (n (+ n i)) (0))) 0.))
)
(and cmd (setvar 'cmdecho cmd))
); progn
); if
(princ)
); defun
对不起，我们不使用英制。 这是一个奇怪的要求。
[列表]
[*]是否希望所有层实体分布在X轴上？
[*]如果边界框大于空间增量怎么办？
[*]如果实体实际上是嵌套的呢？
[/列表]
Grrr：
我认为这些是一样的？
(/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (setq ln (cdr (assoc 2 ld)))))))))
(/= 4 (logand 4 (cdr (assoc 70 ld))))
-大卫
是的，我是“以防万一”走那条路的。从此线程发布#12和#13。
不记得LM信息中的这个重要片段：
谢谢你刷新我的记忆！ 非常感谢你的帮助。对我来说，这是一个奇怪的要求。
在AutoCAD中，丝绸印刷电路的几层是堆叠的（银墨水、碳墨水、电介质墨水…）。
然后，我们的想法是让这些层沿着X轴分布，这样就可以单独选择并转移到生产中。
边界框（帧）的大小与沿X轴的空间增量相同。实体不嵌套。
David Bethel在15分钟内提供代码方面做得很好，哇！他的代码将层分开，不管它们是开的还是关的。
我只希望选定的层沿X轴分布。此外，需要沿增量复制其中一个层：
我解释说，假设我有“银”、“碳”、“电介质”和“框架”层。前三层将沿X轴分布，层“框架”将与这些层中的每一层一起复制。
再次感谢你们的帮助。
; Spacing selection set by layer
(defun C:test ( / lnm SS b L p acDoc Lyrs ln d ln ll ur pl )
(setq lnm "frame") ; <- Adjust the layer name here, to copy along the spacing
(cond
( (not (and (setq SS (ssget "_:L-I")) (princ "\nSelect objects to space by their layer: ")))
(princ "\nNothing selected.")
)
(
(not
(progn
(vlax-for o (setq SS (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list o 'll 'ur))))
(setq b (append b (mapcar 'vlax-safearray->list (list ll ur))))
)
(setq L (cons (list (vla-get-Layer o) o) L))
); vlax-for
(vla-Delete SS)
(and
(or
(and b (setq b (mapcar '(lambda (a b) (/ (+ a b) 2.)) (apply 'mapcar (cons 'min b)) (apply 'mapcar (cons 'max b)))))
(setq b (getpoint "\nSpecify base point: "))
)
(setq p (getpoint b "\nSpecify direction and spacing: "))
)
); progn
); not
(princ "\nSpacing not specified.")
)
(p
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
(mapcar '(lambda (x) (cond ((member x Lyrs)) ((setq Lyrs (cons x Lyrs))))) (mapcar 'car L))
(
(lambda ( x )
(and acDoc (tblsearch "LAYER" x) (member lnm Lyrs) (eq (vla-get-Lock (vla-item (vla-get-Layers acDoc) x)) :vlax-false) (setq ln x) )
)
lnm
)
(mapcar
'(lambda (x)
(cond
(d (setq d (+ d (distance b p))) )
( (setq d (distance b p)) )
)
(mapcar
'(lambda (o)
(if (= x (car o))
(progn
(apply 'vla-Move (append (list (cadr o)) (setq pl (mapcar 'vlax-3D-point (list '(0. 0. 0.) (polar '(0. 0. 0.) (angle b p) d))))))
(if ln (mapcar '(lambda (fr / c) (if (= (car fr) ln) (progn (setq c (vla-Copy (cadr fr))) (apply 'vla-Move (append (list c) pl))))) L))
)
)
)
L
)
)
(vl-remove ln (acad_strlsort Lyrs))
)
(vla-EndUndoMark acDoc)
)
); cond
(princ)
); defun
(vl-load-com) (princ)
哈哈，对不起，我没有把任何代码归功于Grrr Oups！我的错，对不起，Grrr，你是那个拥有所有代码的人。我测试了你的上一个帖子，代码很好用，谢谢！
我知道我问了很多问题，但是有没有一种方法可以将一个层（我们称之为“框架”）复制到其他层上？
最终的结果是所有层沿X轴分布（就像你的代码那样），每个层都有一个相同“帧”层的副本。
在现实生活中，该框架表示在每个框架内具有分离层（电路印刷油墨）的印刷丝绸尺寸。
再次感谢Grrr，我相信你为我节省了几年的工作！ 我已经修改了第#6篇中的代码，请在此处调整您的图层名称：
（setq lnm“帧”）； 代码工作得很好，非常感谢！
我不敢相信它是在24小时内完成的。很高兴我加入了这个论坛。
页:
[1]
2