社区 › Auto Lisp › 按修复更新属性编号

therealjd 发表于 2022-7-5 15:51:51

按修复更新属性编号

我一直在寻找，但我认为我想要的措辞可能会让这个很难找到。
 
我有一个块的多个副本，该块的属性为高程值。即：
 
524.05
517.03
等
 
我需要为所有属性值添加0.3。
所以新的高度应该是
524.35
517.33
 
有人能用Lisp程序做到这一点吗？
 
谢谢
 
法学博士

therealjd 发表于 2022-7-5 16:23:16

好的，刚刚找到这个。。似乎很管用
 
https://www.theswamp.org/index.php?topic=35246.0

Grrr 发表于 2022-7-5 17:15:11

写起来很有趣：
 
(defun C:test ( / enx tag n nm SS i o )
(and
   (setq enx (car (nentsel "\nPick Attribute from block: ")))
   (member '(0 . "ATTRIB") (setq enx (entget enx)))
   (setq tag (cdr (assoc 2 enx))) '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114)
   (setq n (cond ( (getreal (strcat "\nValue to add <1>: ")) ) ( 1 ) ))
   (princ (strcat "\nSelect \"" (setq nm (vla-get-EffectiveName (vlax-ename->vla-object (cdr (assoc 330 enx))))) "\" blocks: "))
   (setq SS (ssget "_:L" (list '(0 . "INSERT")(cons 2 (strcat "`**," nm)) '(66 . 1))))
   (repeat (setq i (sslength SS))
   (and (= nm (vla-get-EffectiveName (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i)))))))
       (vl-some
         (function
         (lambda (x / v)
             (cond
               ( (not (vlax-read-enabled-p x)) nil)
               ( (/= tag (vla-get-TagString x)) nil)
               ( (vl-catch-all-error-p (setq v (vl-catch-all-apply 'read (list (vla-get-TextString x))))) )
               ( (not (vlax-write-enabled-p x)) )
               ( (progn (vla-put-TextString x (vl-string-right-trim "." (vl-string-right-trim "0" (vl-prin1-to-string (+ n v))))) T) )
             )
         )
         )
         (vlax-invoke o 'GetAttributes)
       )
   )
   )
)
(princ)
)
(vl-load-com)(princ)

查看完整版本: 按修复更新属性编号