选择的部分块更名

自贡黄明儒 · 发表于 2015-6-13 09:44:54

;;对于选择的部分块更名，在实际中是很有用的。
;;http://bbs.mjtd.com/forum.php?mo ... gest%3D1&page=3
;;以上alin 版主修改块程序，我一直使用到如今，在此表示感谢！！！
;;由于是vla写成的，我表示看不懂，纯粹拿来主义。
;;但是纯lisp能不能写成呢？
;;在明经和晓东，国内两个顶级论坛上，我从未看到过。因此，下面的程序是首创

;;基于我在峨嵋山修练过的功底和近年来的不断打坐冥想(真事儿)，觉得是可能的,不信请看
;;定义一个新块
(defun _BlockNewName (oldName NewName)
  (setq e (TBLOBJNAME "block" oldName))
  (while e
(setq en (entget e))
(cond
   ((assoc 2 en) (entmake (subst (cons 2 NewName) (assoc 2 en) en)))
   (T (entmake en))
)
(setq e (entnext e))
  )
  (entmake '((0 . "ENDBLK")));定义块尾
)
;;2015.6.13 By 自贡黄明儒
(defun C:PartBlockRename (/ EN N NEWNAME OLDNAME SS)
  (cond
((and (setq ss (ssget '((0 . "INSERT"))))
   (setq NewName (getstring "\n 输入新块名"))
   (/= NewName "")
   )
   (setq oldName (cdr (assoc 2 (entget (ssname ss 0)))))
   (_BlockNewName oldName NewName)
   (repeat
   (setq n (sslength ss))
(setq en (entget (ssname ss (setq n (1- n)))))
(entmod (subst (cons 2 NewName) (assoc 2 en) en))
   )
)
  )
  (princ)
)

adc · 发表于 2015-8-31 13:08:28

本帖最后由 adc 于 2015-8-31 13:13 编辑

(defun c:dkgm (/ e en j new old ss)
  (defun dxf (a b) (cdr (assoc a b)))
  (command "undo" "group")
  (if
(and (setq ss (ssget '((0 . "INSERT"))))
   (setq new (getstring "\n输入的块新名称:"))
   (not (tblsearch "block" new))
)
   (progn (setq old (dxf 2 (entget (ssname ss 0))))
      (command "-insert" old '(0 0) "1" "1" 0)
      (command "explode" (entlast))
      (command "-block" new '(0 0) "P" "")
      (setq j 0)
      (repeat (sslength ss)
      (setq e  (ssname ss j)
      en (entget
   e
         )
      en (subst (cons 2 new) (assoc 2 en) en)
      )
      (entmod en)
      (setq j (1+ j))
      )
   )
  )
  (command "undo" "end")
  (princ)
)

G〆h · 发表于 2019-7-26 17:57:38

经测试，好像不支持动态块嘛！一直想实现动态块和属性块的单独改名。

zhenz02 · 发表于 2019-7-27 10:54:24

收藏留着慢慢看，谢谢楼主

yoyoho · 发表于 2015-6-13 09:55:01

黄老师你好! 部分块更名,实用的程序感谢分享!

Linhay · 发表于 2015-6-13 09:56:29

大师,加油

yoyoho · 发表于 2015-6-13 10:09:55

黄老师你好! 程序对于块中含块的有问题喔?

aihuyujian · 发表于 2015-6-13 10:22:30

不明觉厉

434939575 · 发表于 2015-6-13 10:24:01

黄大师，请坚持

lucas_3333 · 发表于 2015-6-13 10:37:50

黄大师又耐不住寂寞啦

baoxiaozhong · 发表于 2015-6-13 10:42:26

謝謝你的源碼分享。

rhww · 发表于 2015-6-13 11:15:44

謝謝你的源碼分享

菜卷鱼 · 发表于 2015-6-13 11:49:50

看看黄老师高见

账号		自动登录	找回密码
密码			注册

[源码] 选择的部分块更名

评分

点评