Lisp更改为所有尺寸乐筑天下 - Powered by Discuz! Archiver

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

Lisp更改为所有尺寸

你好

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

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

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

有人能帮我吗？

提前谢谢。

当做

尼古拉斯

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

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

(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))

我想改变一句话，即：

(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

看看这个

(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

嗨，尼古拉斯，

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

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

(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

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

(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

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

页: [1] 2

乐筑天下's Archiver

Lisp更改为所有尺寸