需要调整Lisp程序乐筑天下 - Powered by Discuz! Archiver

PaulS00 发表于 2022-7-5 17:43:29

需要调整口齿不清

你好

我有一个LISP，它将所有x-REF放置在“x-REF”层上。我需要做的调整是，如果层不存在，创建它，并锁定该层。

还有，我明白了
当我插入另一个引用并运行LISP时。
这是我的。。。

(defun c:xchx (/ ss i vla)
(if (setq ss (ssget "_x" '((0 . "INSERT"))))
(repeat
(setq i (sslength ss))
   (setq vla (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
   (if (vlax-property-available-p vla 'Path)
   (vla-put-layer vla "x-ref")
   )
)
(princ)
)
(princ)
)

Tharwat 发表于 2022-7-5 17:49:08

你好

lisp将所有块（而不仅仅是外部参照）移动到x-ref层（如果存在）。

PaulS00 发表于 2022-7-5 17:56:38

我只是测试了它，它不包括插入块。

Tharwat 发表于 2022-7-5 17:58:20

你贴的代码我很熟悉！

无论如何，试试这个动态的；

(defun c:xchx(/ doc ss i sn e l)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for xr(vla-get-blocks doc)
(if (eq :vlax-true (vla-get-isxref xr))
(setq l (cons (strcat "," (vla-get-name xr)) l))
)
)
(if (not (tblsearch "LAYER" "x-ref"))
(entmake (list '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               (cons 2 "x-ref")
               '(70 . 0)))
)
(if (and l (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (substr (apply 'strcat l) 2))))))
(repeat
(setq i (sslength ss))
   (if (vlax-write-enabled-p (vlax-ename->vla-object (setq sn (ssname ss (setq i (1- i))))))
   (entmod
      (subst '(8 . "x-ref") (assoc 8 (setq e (entget sn))) e))
   )
   )
)
(princ)
)(vl-load-com)

PaulS00 发表于 2022-7-5 18:02:01

我真的很感谢你的努力！

我得到了这个。。。

Tharwat 发表于 2022-7-5 18:10:35

当你想回复时，没有必要引用每一个回复。

您可能没有外部参照到当前图形中，或者正在使用AutoCAD以外的程序。

PaulS00 发表于 2022-7-5 18:14:07

使用Civil 3D 2016。

Tharwat 发表于 2022-7-5 18:17:24

我已修改了上述代码，请重试代码。

PaulS00 发表于 2022-7-5 18:22:38

负介电体

Tharwat 发表于 2022-7-5 18:25:34

对不起，我正忙于另一个程序，我没有测试就发布了代码，但现在应该可以了。

代码再次更新。

页: [1] 2

乐筑天下's Archiver

需要调整口齿不清