Lisp更改为所有尺寸

nicolas · 发表于 2022-7-5 15:02:16

你好

我正在寻找一个lisp代码，它可以在所有标注样式中对变量执行3个更改，即：

1.尺寸线-颜色设置为52
2.尺寸界线-颜色设置为52
3.文字外观-颜色设置为52

为了进一步推进，我还需要对特定文件夹中的所有图形执行此lisp。

有人能帮我吗？

提前谢谢。

当做

尼古拉斯

nicolas · 发表于 2022-7-5 15:08:21

以下是李·麦克的代码，为了满足我的需要，我稍微修改了一下：

copy


(defun c:tnm (/ dimlst doc ss)
 (vl-load-com)
 (setq dimlst '("1" "2" "3")) ;; Change as necessary
 
 (vlax-for dim (vla-get-Dimstyles
                 (setq doc
                   (vla-get-ActiveDocument
                     (vlax-get-acad-object))))
   (if (vl-position (vla-get-Name dim) dimlst)
     (progn
       (vla-put-activeDimstyle doc dim)
       (setvar "DIMCLRE" 52)
       (setvar "DIMCLRD" 52)
   (setvar "DIMCLRT" 52)
       (vla-copyfrom dim doc))))
 (if (setq ss (ssget "_X" '((0 . "DIMENSION"))))
   (mapcar 'vla-update
     (mapcar 'vlax-ename->vla-object
       (mapcar 'cadr (ssnamex ss)))))
 
 (princ))

我想改变一句话，即：

copy

 (setq dimlst '("1" "2" "3")) ;; Change as necessary

如果应用程序能够自动列出所有标注样式并将其保存到变量dimlst中，那就太好了。

Dadgad · 发表于 2022-7-5 15:16:32

这不是Lisp程序，也不可能像李的Lisp程序那样有效，

但是，通过配置标准选项，您可以非常接近您的目标
并使用。dws文件，同时进行批量检查。

Tharwat · 发表于 2022-7-5 15:21:54

看看这个

copy


(defun c:Test (/ d dim ss i obj)
 (vl-load-com)
 (cond ((not acdoc)
        (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
       )
 )
 (while (setq d (tblnext "DIMSTYLE" (null d)))
   (setq dim (vla-item (vla-get-Dimstyles
                         acdoc
                       )
                       (cdr (assoc 2 d))
             )
   )
   (vla-put-activeDimstyle acdoc dim)
   (setvar "DIMCLRE" 52)
   (setvar "DIMCLRD" 52)
   (setvar "DIMCLRT" 52)
   (vla-copyfrom dim acdoc)
 )
 (if (setq ss (ssget "_X" '((0 . "DIMENSION"))))
   (repeat (setq i (sslength ss))
     (setq obj (ssname ss (setq i (1- i))))
     (vla-update (vlax-ename->vla-object obj))
   )
 )
 (princ)
)

Lee Mac · 发表于 2022-7-5 15:27:53

嗨，尼古拉斯，

这是我的一些非常古老的代码，你已经发现了！

下面是我今天如何重写函数：

copy

(defun c:dimupd ( / adm doc sel styles )
   (setq styles '("1" "2" "3") ;; Dimension Styles to Update
         styles  (mapcar 'strcase styles)
   )
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         adm (vla-get-activedimstyle doc)
   )
   (vlax-for dim (vla-get-dimstyles doc)
       (if (member (strcase (vla-get-name dim)) styles)
           (progn
               (vla-put-activedimstyle doc dim)
               (setvar 'dimclre 52)
               (setvar 'dimclrd 52)
               (setvar 'dimclrt 52)
               (vla-copyfrom dim doc)
           )
       )
   )
   (if (ssget "_X" '((0 . "*DIMENSION")))
       (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset doc))
               (vl-catch-all-apply 'vla-update (list obj))
           )
           (vla-delete sel)
       )
   )
   (vla-put-activedimstyle doc adm)
   (princ)
)
(vl-load-com) (princ)

nicolas · 发表于 2022-7-5 15:31:13

感谢李·麦克、塔瓦和达加德提供的代码。Tharwat的代码运行良好。它会自动将更改应用于所有标注样式，而不考虑名称。有没有办法将塔尔瓦特代码的这一特性融入李·麦克的更新代码中？有没有一种方法可以在不使用script Pro之类的脚本程序的情况下，将此代码中的指令自动携带到特定文件夹（如Lee Mac的Bfind lisp）中的所有图形？或者，是否有一个程序可以在包含DCL功能的某个库中执行更多的操作？

nicolas · 发表于 2022-7-5 15:38:32

感谢DADGAD的标准功能。我几年前读过这篇文章，但从未真正尝试过。我会尽全力学习这个功能，因为我相信它会对我有很大帮助。

Lee Mac · 发表于 2022-7-5 15:41:05

哦，我以为你只想修改某些样式，修改所有样式更简化了代码：

copy

(defun c:dimupd ( / adm doc sel )
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         adm (vla-get-activedimstyle doc)
   )
   (vlax-for dim (vla-get-dimstyles doc)
       (vla-put-activedimstyle doc dim)
       (setvar 'dimclre 52)
       (setvar 'dimclrd 52)
       (setvar 'dimclrt 52)
       (vla-copyfrom dim doc)
   )
   (if (ssget "_X" '((0 . "*DIMENSION")))
       (progn
           (vlax-for obj (setq sel (vla-get-activeselectionset doc))
               (vl-catch-all-apply 'vla-update (list obj))
           )
           (vla-delete sel)
       )
   )
   (vla-put-activedimstyle doc adm)
   (princ)
)
(vl-load-com) (princ)

Tharwat · 发表于 2022-7-5 15:50:43

不客气，很高兴我的代码为您工作。

作为对该问题解决方案的操作，请尝试我的例程中的以下代码，并将其添加到您的acaddoc中。lsp或使用命令“appload”并将代码添加到内容（公文包）中，以便能够在所有新的打开图形上自动运行代码。在那之后，打开所有需要的绘图，代码就会完成，保存并单独关闭每个绘图。

完成从Autocad分离代码以避免在所有新打开的图形上执行代码时。

jamesjh · 发表于 2022-7-5 15:52:36

这太棒了。我应该添加什么来更改文字大小、箭头大小和文字偏移距离？

[编程交流] Lisp更改为所有尺寸

发表回复

精选推荐