sinommw 发表于 2013-12-26 23:38:26

求助！RENAME加強、改块基点

我在平时工作中，经常用到RENAME这个命令更改图块名字，但常常需要先记下要更改的图块名字，然后用RENAME命令，找到相应的块，然后赋予新的块名称，操作起来效率较低。

希望高手帮忙写个2个LISP，实现以下功能：
LISP1
1.当前有选择块对象时，可以直接输入新的名字更改；
2.当前无选择块对象时，提示选择，然后输入名字。

LISP2
1.当前有选择块对象时，可以直接输入或指定新的基点；
2.当前无选择块对象时，提示选择，输入或指定新的基点。

谢谢大家！





masterlong 发表于 2013-12-27 00:05:30

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87852
除了无预选择功能外
基本满足你的需要

sinommw 发表于 2013-12-27 02:27:02

masterlong 发表于 2013-12-27 00:05 static/image/common/back.gif
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=87852
除了无预选择功能外
基本满足你的需要

上面那个贴子的附件我下载了，但是不知道怎么用。。。

菜卷鱼 发表于 2013-12-27 21:10:52

改块名字的，不记得是哪个大师写的了，自己一直在用
(vl-load-com)
(defun c:RN (/ ent name name1 dclname tempname filen stream dcl_re dlg new obj blocks BlkNam block DOC )
(if (and (setq ent (car (entsel "\n选择需要改名的块: ")))
         (or (eq "INSERT" (cdr (assoc 0 (entget ent)))) (alert "没有选择块!"))
      )
    (progn
      (setq name (cdr (assoc 2 (entget ent))))
      (setq dclname
      (cond
          (
            (setq tempname (vl-filename-mktemp "re-dcl-tmp.dcl") filen (open tempname "w"))
            (foreach stream '(
"\n"
"RENAME:dialog {\n"
"    label = \"修改块名\" ;\n"
"    :row {\n"
"      :edit_box {\n"
"            key = \"dcl_edit_name\" ;\n"
"            width = 30 ;\n"
"      }\n"
"    }\n"
"    :row {\n"
"      :button {\n"
"            key = \"btn_ok\" ;\n"
"            label = \"确认\" ;\n"
"      }\n"
"      :button {\n"
"            is_cancel = true ;\n"
"            key = \"btn_cancle\" ;\n"
"            label = \"取消\" ;\n"
"      }\n"
"    }\n"
"}\n"
            )
            (princ stream filen)
            )
            (close filen)
            tempname
          )
      )
      )
      (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq obj (vlax-ename->vla-object ent))
      (setq blocks (vla-get-blocks DOC))
      (setq dcl_re (load_dialog dclname))
      (if (not (new_dialog "RENAME" dcl_re)) (exit))
      (set_tile "dcl_edit_name" name)
      (mode_tile "dcl_edit_name" 2)
      (action_tile "dcl_edit_name" "(setq name1 $value)")
      (action_tile "btn_ok" "(if (=(vla-get-objectname obj) \"AcDbBlockReference\")
                               (if (tblsearch \"block\" name1)
                                 (alert (strcat \"块名: \" name1 \" 已经存在.\"))
                                 (if (not (snvalid name1))
                                 (alert (strcat \"错误的块名: \" name1))
                                 (done_dialog 1)
                                 )
                               )
                           )"
      )
      (setq dlg (start_dialog))
      (if (= dlg 1)
      (progn
          (setq BlkNam (vla-get-name obj))
          (setq block(vla-item blocks BlkNam))
          (vla-put-name block name1)
          (if (= (substr BlkNam 1 2) "*U")
            (progn
            (princ "\n这是一个匿名块.")
            (vla-auditinfo DOC :vlax-true)
            (vla-put-name block name1)
            )
          )
          (princ (strcat "\n图块 \"" name "\" 重命名为 \"" name1 "\""))
      )
      )
      (unload_dialog dcl_re)
      (vl-file-delete dclname)
    )
)
(princ)
)

sinommw 发表于 2013-12-27 22:35:03

菜卷鱼 发表于 2013-12-27 21:10 static/image/common/back.gif
改块名字的，不记得是哪个大师写的了，自己一直在用

感谢分享，程序非常好用，美中不足是不能预先选择，但这点无关紧要。

maiko 发表于 2013-12-27 23:08:29

sinommw 发表于 2013-12-27 22:35 static/image/common/back.gif
感谢分享，程序非常好用，美中不足是不能预先选择，但这点无关紧要。
entsel函数本身就不能先选择后操作

sinommw 发表于 2013-12-28 00:13:28

已在论坛找到改基点程序。
传送门： ChangeBlockInsertionV1-3.lsp

感谢大家的帮助！

菜卷鱼 发表于 2013-12-28 08:14:31

本帖最后由 菜卷鱼 于 2013-12-28 08:16 编辑

(if (and (setq ent (car (entsel "\n选择需要改名的块: ")))

改成

(princ "\n选择需要改名的块: ")
(if (and (setq ent (ssname (ssget ":s" '((0 . "INSERT")) ) 0))

就可以先选择后操作了

xyp1964 发表于 2013-12-28 09:18:57

能否批改及适应属性块？

sinommw 发表于 2013-12-28 15:42:11

非常感谢，增加预选之后更加方便了！
页: [1] 2
查看完整版本: 求助！RENAME加強、改块基点