宏？

pvd · 发表于 2022-7-6 11:45:58

大家好，

我正在寻找一些东西，把颜色，线型和线宽的对象按层。这有宏吗？谁能帮我，因为我对Visual Basic一无所知。

非常感谢你

Lee Mac · 发表于 2022-7-6 11:52:50

VLISP：


(defun c:test (/ i obj ss)
 (vl-load-com)
 (setq i -1 *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))
 
 (cond ((ssget "_:L")
        (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
          (mapcar
            (function (lambda (prop value) (vlax-put-property obj prop value)))
            '(Color Linetype Lineweight) (list acByLayer "ByLayer" acLnWtByLayer)))
        (vla-delete ss)))
 (princ))

Lee Mac · 发表于 2022-7-6 11:56:59

我的VBA很差，但是：

copy


Sub 2ByLayer ( )
 Dim sSet As AcadSelectionSet
 Set sSet = ThisDrawing.SelectionSets.Add("ByLayerSet")
 sSet.SelectOnScreen
 For i = 0 To sSet.Count
   sSet.Item(i).Linetype = "BYLAYER"
   sSet.Color = acByLayer
   sSet.Lineweight = acLnWtByLayer
 Next i
 sSet.Delete
End Sub

感谢对VBA的建议。。。

pvd · 发表于 2022-7-6 12:06:37

非常感谢李！
现在请原谅我的愚蠢，但我无法让脚本工作。我将代码粘贴到我的Visual LISP编辑器中，对吗？然后我做什么？

再次感谢

Lee Mac · 发表于 2022-7-6 12:12:29

有几种方法可以实现：
[列表]

打开VLIDE，File>NewFile，粘贴代码并单击图标加载代码

[/列表]
[列表]

将代码另存为。lsp文件，通过启动套件加载。
[/列表]
[列表]

将代码粘贴到命令行以加载它。
见此处：

http://www.cadtutor.net/forum/showthread.php?t=1390

pvd · 发表于 2022-7-6 12:18:02

太好了，李，谢谢你让我开始！

dbroada · 发表于 2022-7-6 12:23:23

我不得不这么做。。。。。。

copy

Public Sub AByLayer()
Dim i as Integer
 Dim sSet As AcadSelectionSet
 Set sSet = ThisDrawing.SelectionSets.Add("ByLayerSet")
 sSet.SelectOnScreen
 For i = 0 To sSet.Count - 1
   sSet.Item(i).Linetype = "ByLayer"
   sSet.Item(i).color = acByLayer
   sSet.Item(i).Lineweight = acLnWtByLayer
 Next i
 sSet.Delete
End Sub