需要调整Lisp程序

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

你贴的代码我很熟悉！

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

copy


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