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

需要Lisp更新属性

我需要一个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

快速编写且未经测试!
 

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

没有问题
页: [1]
查看完整版本: 需要Lisp更新属性