社区 › Auto Lisp › 块属性重新编号

Cad64 发表于 2022-7-5 17:44:12

块属性重新编号

大家好，我需要一个Lisp程序的程序，我希望有人能帮助我。我不认为这很复杂，但这超出了我的技能范围。
 
我需要的是一种对SDE块中的属性重新编号的方法。
 
我正在处理的块包含4个属性，但唯一需要更改的属性是“阀号”。（见下面的屏幕截图）。
 
有时，在布置大型灌溉计划时，我可能需要返回并在布局中间的某个位置放置另一个阀门。这意味着我必须重新编号所有其他阀门，手动操作可能需要相当长的时间。
 
理想情况下，我希望有一个例程，让我指定起始阀编号，然后让我单击每个块，在单击每个块时增量更新编号。例如，假设我需要将阀门A-6重新编号为A-40。我希望能够启动例行程序，键入6作为起始数字，然后开始点击块自动重新编号。
 
此外，我的示例中的“阀号”是A-1，但字母并不总是“A”。有时它会是“B”或“C”或任何东西，因此只有破折号后的数字可以更改。
 
感谢您的关注，如果您需要更多信息，请告诉我。我会上传区块，但它属于我的客户，所以我不能。

abra-CAD-abra 发表于 2022-7-5 18:03:42

试试Gile的这款小宝石：
 
https://apps.autodesk.com/ACD/en/Detail/Index?id=8051485828049059617&appLang=en&os=Win32_64
 
希望有帮助。。
 
干杯

Tharwat 发表于 2022-7-5 18:18:37

你好
 
请尝试一下我刚刚写的这个程序，告诉我你是如何使用它的，如果你需要任何进一步的功能扩展；
 


(defun c:IncAtts (/ *error* run st blk e at pre num v)
;;        Tharwat. cadtutor        ;;
;;        Date:04.May.2016        ;;

(defun *error* (msg)
   (if (and msg
            (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
            )
   (princ (strcat "\nError: " msg))
   )
   (princ)
   )
(setq run t)
(while (not (setq *starting:number*
                  (cond ((and (setq st
                                       (getstring
                                       (strcat
                                           "\nSpecify starting number after char: eg. <"
                                           (if *starting:number*
                                             *starting:number*
                                             (setq *starting:number* "A-1")
                                             )
                                           ">: "
                                           )
                                       )
                                    )
                              (eq st "")
                              )
                           *starting:number*
                           )
                        ((and (wcmatch st "*-#*")
                              (numberp (+ 2 (vl-string-search "-" st)))
                              )
                           (setq *starting:number* st)
                           )
                        (t nil)
                        )
                   )
             )
   (princ "\nUncorrect string!. Try again")
   )
(princ "\nSelect attributed block with Tag name <1>:")
(while
   (and
   run
   (setq blk
            (car
            (entsel
               )
            )
         )
   (eq (cdr (assoc 0 (setq e (entget blk)))) "INSERT")
   (eq (cdr (assoc 66 e)) 1)
   (if (vl-some
         '(lambda (x)
            (and (eq (vla-get-tagstring x) "1")
                   (setq at x)
                   )
            )
         (vlax-invoke (vlax-ename->vla-object blk) 'getattributes)
         )
       at
       (progn
         (princ "\nAttributed Block doesn't have tag name <1> !")
         (setq run nil)
         )
       )
   )
    (vla-put-textstring
      at
      (setq pre               (substr *starting:number*
                                    1
                                    (1+ (vl-string-search "-" *starting:number*))
                                    )
            num               (substr
                              *starting:number*
                              (+ 2 (vl-string-search "-" *starting:number*))
                              )
            *starting:number* (strcat pre (itoa (1+ (atoi num))))
            v               (strcat pre num)
            )
      )
    )
(princ)
)(vl-load-com)

Cad64 发表于 2022-7-5 18:29:19

 
谢谢你的链接。这看起来很好，但实际上比我需要的要多。这个程序将被我客户办公室的其他人使用，我担心所有这些选项都会让一些用户感到困惑和不知所措。我正在寻找一些超级简单的东西，可以从命令行运行，没有对话框。只需运行命令，输入起始编号，然后开始。

Cad64 发表于 2022-7-5 18:33:56

 
嗨，塔瓦特，这正是我想要的，它似乎工作得很好。谢谢你花时间写这篇文章。这将非常有帮助。

Tharwat 发表于 2022-7-5 18:48:34

 
很好，很乐意帮忙。

查看完整版本: 块属性重新编号