社区 › Auto Lisp › LISP例程请求

dbroada 发表于 2022-7-6 10:47:17

LISP例程请求

我目前正在努力使用AutoCAD electrical，尝试使用自动导线编号来完成我希望它完成的任务。我现在已经放弃了，决定用Lisp程序的语言做我想做的事（现在）。有人能帮我凑点东西给我老板看看吗？
 
我只需要用一些现有属性的串联来填充我的两个新属性。易于理解的
 
属性F-Term01=Tag1&“-”&Term01
属性F-Term02=Tag1&“-”&Term02
 
现在，一个简单的“选择块”就可以了，但当我开始做更多的学习时，这种可能性会增加。
 
非常感谢，但如果有人能帮我做这件事，我就不喝啤酒了。

Lee Mac 发表于 2022-7-6 10:51:54

戴夫，
 
我相信这可以很快完成，当我一分钟后-但我不确定我是否理解你的符号在那里。。。
 
我说得对吗
 
属性标签=F-Term01
 
值需要为：-Term01
 
对的

dbroada 发表于 2022-7-6 10:55:35

对不起，我今天晚上试图关机时正在打字
 
不急，我明天才能看，但是。。。
 
我需要将名为“TAG1”的属性值和一个破折号以及名为“TERM01”的属性值放入名为“F-TERM01”的属性中

alanjt 发表于 2022-7-6 10:57:52

 
(defun c:TEst (/ o)
(if (setq o (car (entsel "\nSelect block: ")))
   (if (eq (vla-get-objectname (setq o (vlax-ename->vla-object o)))
         "AcDbBlockReference"
       )
   (if (eq (vla-get-hasattributes o) :vlax-true)
       (foreach a (vlax-invoke o 'GetAttributes)
         ((lambda (s)
;;;         (vla-put-textstring a (strcat s "=" (substr s 3)))
            (cond
            ((eq (strcase s) "TAG1") (vla-put-textstring a "-"))
            ((eq (strcase s) "TERM01")
               (vla-put-textstring a "F-Term01")
            )
            )
          )
         (vla-get-tagstring a)
         )
       )
       (princ "\nBlock has no attributes!")
   )
   (princ "\nObject must be a block!")
   )
)
(princ)
)

dbroada 发表于 2022-7-6 11:02:24

谢谢艾伦。我想知道你们俩谁会是第一个。
 
我明天上班时会试试看。
 
哦，顺便问一下，你发现最初的请求是2个属性了吗。F-Term01和F-Term02。我相信我能想出如何添加它，但你介意帮我添加吗，pplleeaassee。

alanjt 发表于 2022-7-6 11:04:02

没问题。我有几分钟空闲时间等待午餐的到来。

Lee Mac 发表于 2022-7-6 11:07:59

试一试Dave：
 

(defun c:Dave ( / ent atts tag1 )
(vl-load-com)
;; Lee Mac~18.05.10

(if
   (setq ent
   (SelectifFoo
       (lambda ( x )
         (and
         (eq "INSERT" (cdr (assoc 0 (entget x))))
         (= 1 (cdr (assoc 66 (entget x))))
         )
       )
       "\nSelect Block to Update: "
   )
   )
   (progn
   (setq atts
       (mapcar
         (function
         (lambda ( attrib )
             (cons
               (strcase
               (vla-get-TagString attrib)
               )
               attrib
             )
         )
         )
         (vlax-invoke
         (vlax-ename->vla-object ent) 'GetAttributes
         )
       )
   )
   (if (and (setq tag1 (cdr (assoc "TAG1" atts)))
            (setq tag1 (vla-get-TextString tag1)))
       (mapcar
         (function
         (lambda ( stag dtag )
             (if (and (setq x (cdr (assoc stag atts)))
                      (setq y (cdr (assoc dtag atts))))
               (vla-put-TextString y                  
               (strcat tag1 "-" (vla-get-TextString x))
               )
             )
         )
         )
         '("TERM01"   "TERM02")
         '("F-TERM01" "F-TERM02")
       )
   )
   )
)
(princ)            
)

(defun SelectifFoo ( foo str / sel ent )
(while
   (progn
   (setq sel (entsel str))
   
   (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
         (princ "\n** Invalid Object Selected **")
         )
       )
   )
   )
)
ent
)

dbroada 发表于 2022-7-6 11:11:36

谢谢各位，
 
我试了李的第一次，一旦我记得改变我的区块（忘记保存昨晚），它做了我需要的。
 
Alan，你的用破折号替换了Tag1，用字符串F-Term01替换了属性Term01，但保持了属性F-Term01不变（空）。但这可能是我的描述。李以前为我写过一些套路，所以以前也听过我的喃喃自语
 
不过有几个问题。
 
如果TermXX有值，是否可以将例程更改为仅填充F-TermXX？因此，如果TermXX有值，则两个F-Term属性都会填充，如果只有一个项有值，则只填充一个，如果没有给定TermXX值，则两者都不会填充。AcadE的性质确保Tag1始终具有价值。
 
最后。。。。。。
 
我们将该值提取到文本文件中，用于打印热缩线标记。将层“套圈”上的所有文本或名为“F-*”的所有属性提取到文本文件中是否容易（不要求这样做）？按层还是按标记名，哪个更容易？

Lee Mac 发表于 2022-7-6 11:13:16

我很高兴它对你有用Dave
 
至于你的另一个请求-按层将更容易，因为在使用ssget过滤器时，没有针对属性的直接过滤方法，因此必须依次查看每个块-不是说无法完成，而是按层提取文本更容易。
 
我会在演讲结束后一分钟修改代码

dbroada 发表于 2022-7-6 11:17:34

谢谢李。
 
如果我去VB，ByLayer也适合我。未来的净路线
 
我已经向我的老板展示了我的提议，他对这种方法很满意。这几天不需要强迫AcadE屈服。我现在可以在下周末去度假了，我有一个明确的想法：眨眼。
 
好好讲一讲。

查看完整版本: LISP例程请求