需要Lisp更新属性

cabltv1 · 发表于 2022-7-6 15:11:38

我需要一个lisp例程，它将执行以下操作。。。
1）单击具有2个属性的块：
节点ID
AMP\U ID
2）单击另一个块以更新2个属性：
NODE\u ID（这应该等于第一个块的NODE\u ID）
设备编号（这应该等于第一个块的AMP\U ID）

谢谢你的帮助！

Lee Mac · 发表于 2022-7-6 15:27:10

哈哈，你和你的街区。。。

您希望第二个选项用于多个区块吗？还是自动化？或者你宁愿只是一个简单的点击两下的工作

cabltv1 · 发表于 2022-7-6 15:44:59

对又是我。我这个大项目就要完成了。
我需要一次选择多个目标区块。

再次感谢你的帮助。

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

快速编写且未经测试！

copy


(defun c:blkupd     (/ bEnt aEnt eLst aNode aAmp ss EntLst attEnt attEntLst)
 (if (and (setq bEnt (car (entsel "\nSelect Block to Retrieve Attribute Values >   ")))
      (= "INSERT" (cdadr (entget bEnt))) (= 1 (cdr (assoc 66 (entget bEnt)))))
   (progn
     (setq aEnt (entnext bEnt))
     (while (= "ATTRIB" (cdadr (setq eLst (entget aEnt))))
   (cond ((= "NODE_ID" (cdr (assoc 2 eLst)))
          (setq aNode (cdr (assoc 1 eLst))))
         ((= "AMP_ID" (cdr (assoc 2 eLst)))
          (setq aAmp (cdr (assoc 1 eLst)))))
   (setq aEnt (entnext aEnt)))
     (if (and aNode aAmp)
   (progn
     (if (setq ss (ssget (list (cons 0 "INSERT")(cons 66 1)
       (if    (getvar "CTAB")(cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
       (progn
         (setq EntLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
         (foreach e  EntLst
       (setq attEnt (entnext e))
       (while (= "ATTRIB" (cdadr (setq attEntLst (entget attEnt))))
         (cond    ((= "NODE_ID" (cdr (assoc 2 attEntLst)))
            (entmod (subst (cons 1 aNode) (assoc 1 attEntLst) attEntLst)))
           ((= "DEVICE_NUMBER" (cdr (assoc 2 attEntLst)))
            (entmod (subst (cons 1 aAmp) (assoc 1 attEntLst) attEntLst))))
         (setq attEnt (entnext attEnt)))))
       (princ "\n<!> No Blocks Selected <!>")))
   (princ "\n<!> Selected Block Doesn't Contain Required Attributes <!> ")))
   (princ "\n<!> No Block Selected <!>"))
 (command "_regenall")
 (princ))

cabltv1 · 发表于 2022-7-6 16:05:11

你又做了一次！
再次感谢你的帮助。

Lee Mac · 发表于 2022-7-6 16:23:33

没有问题

[编程交流] 需要Lisp更新属性

发表回复

精选推荐