修改一个改块名的程序

ucuc2003 发表于 2013-6-25 12:59:56

本帖最后由 ucuc2003 于 2013-7-4 14:59 编辑

以下是改块名(TT1)的源码，改块名选字的时候仅支持单行文字。

我把它改成了可以选任意文字做块名，这段运行没有出错
但是在自定义输入文字的时候，出现了：; 错误: 参数类型错误: stringp nil。
不知道是哪里出现了问题，请大侠帮我看下，谢谢了！

(defun c:TT1 (/ NAME NEW-NAME)
(setq    name (Vlax-Get (Vlax-Ename->Vla-Object
                     (car (entsel "\n选择要改块名的块："))
                     )
                     'Name
         )
)
(setq ss-text (entsel "\n选择新块名称文字:"))
(if (= ss-text nil)
(setq new-name (getstring "\输入新的块名:"))
(setq new-name (Vlax-Get (Vlax-Ename->Vla-Object
                           (car ss-text)
                           )
                           'TextString
               )
)
)
(command "_.rename" "_block" name new-name)
(princ)
)

;;;以下改块名(TT2)是我修改的
(defun c:tt2 (/ name en new_name entype source_txt)
(setvar "cmdecho" 0)

(vl-load-com)
(setq name (Vlax-Get (Vlax-Ename->Vla-Object
                     (car (entsel "\n选择要改名的块："))
                     )
                     'Name
         )
)

;;;本段代码参考——明经通道《文字刷 by_阿甘》
(setq en (nentsel (strcat "\n原块名为:<" name ">. 选择新块名称的文字<或自定义输入>: ")))
(if (= en nil)
   (setq new-name (getstring (strcat "\n原块名为:<" name ">. 输入新的块名: ")))
   (setq en_data (entget (car en))
         entype (cdr (assoc 0 en_data))
source_txt (if (= entype "ATTDEF")(cdr (assoc 2 en_data))(cdr (assoc 1 en_data)));如果是属性字，则取“标记”为源文字
   )
)

(setq new_name source_txt)
(if (tblsearch "block" new_name)
(princ (strcat "\n新块名< " new_name " >已经存在.请重试!"))
(progn
   (command "_.rename" "_block" name new_name)
   (princ (strcat "\n原块已重命名为: " new_name))
)
)
(princ)
)

这个我自己搞好了，发上来供大家下载

ucuc2003 发表于 2013-6-25 13:14:34

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101548

自贡黄明儒 发表于 2013-6-25 14:18:20

到精华贴中去找找吧，多年前，有版主就贴出来了

ucuc2003 发表于 2013-6-25 14:20:03

自贡黄明儒发表于 2013-6-29 09:18 static/image/common/back.gif
到精华贴中去找找吧，多年前，有版主就贴出来了
谢谢黄兄提醒！！

ucuc2003 发表于 2013-6-25 14:36:12

自贡黄明儒发表于 2013-6-29 09:18 static/image/common/back.gif
到精华贴中去找找吧，多年前，有版主就贴出来了
请问黄兄是在AutoLISP/Visual LISP 编程技术版里吗？搜索精华帖才5页...没找到

自贡黄明儒 发表于 2013-6-25 14:46:09

我原来不是在这里下的
X版的我想也行http://bbs.mjtd.com/forum.php?mod=viewthread&tid=86432&page=1#pid460627

ucuc2003 发表于 2013-6-27 16:25:01

未解决，自己顶一个

ucuc2003 发表于 2013-6-30 14:45:32

自己已搞定，有需要的可以联系我

ucuc2003 发表于 2013-6-30 18:36:20

本帖最后由 ucuc2003 于 2013-7-4 14:30 编辑

;;;;选字改块名RB2
(defun c:RB2()(c:GKM))
(defun GKM_ZMH ()
(setvar "cmdecho" 0)
(defun *Error* (msg);出错处理
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
(princ))
);defun *Error*
(setq new-name (getstring T (strcat "\n原块名为:<" name ">. 输入新的块名: ")))
(if (tblsearch "block" new-name)
(princ (strcat "\n新块名<" new-name ">已经存在请重试!"))
(progn
   (command "_.rename" "_block" name new-name)
   (princ (strcat "\n原块已重命名为:<" new-name ">"))
)
)
(princ)
)

(defun c:GKM (/ name en new_name entype source_txt)
(setvar "cmdecho" 0)
(defun *Error* (msg);出错处理
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
(princ))
);defun *Error*
(princ "选字改块名")
(vl-load-com)
(setq name (Vlax-Get (Vlax-Ename->Vla-Object
                     (car (entsel "\n选择要改名的块："))
                     )
                     'Name
         )
)

;;;本段代码参考——明经通道《文字刷 by_阿甘》
(setq en (nentsel (strcat "\n原块名为:<" name ">. 选择新块名称的文字<或自定义输入>: ")))
(if (= en nil)
   (progn
   (GKM_ZMH)
   )
   (progn
      (setq en_data (entget (car en))
            entype (cdr (assoc 0 en_data))
            source_txt (if (= entype "ATTDEF")(cdr (assoc 2 en_data))(cdr (assoc 1 en_data)));如果是属性字，则取“标记”为源文字
      )
      (setq new_name source_txt)
   )
)

(if (tblsearch "block" new_name)
(princ (strcat "\n新块名< " new_name " >已经存在.请重试!"))
(progn
   (command "_.rename" "_block" name new_name)
   (princ (strcat "\n原块已重命名为: " new_name))
)
)
(princ)
)

848818376 发表于 2013-6-30 19:25:29

RB2 ; 错误: no function definition: C:GKM?

页: [1] 2

明经CAD社区's Archiver

修改一个改块名的程序