明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2782|回复: 10

[提问] 求改某一块名

[复制链接]
发表于 2013-4-23 01:04 | 显示全部楼层 |阅读模式
10明经币
本帖最后由 weiqi 于 2013-5-22 22:01 编辑

图里有 多个块,选者对象 只改 单个块名。

有一个程序有这功能。
http://bbs.mjtd.com/thread-19105-1-1.html
27楼的回复。

搞了很久,简化不来。。。

求简化,只要选者对象 和 输入新块名。望高手出手~

最佳答案

查看完整内容

我把命令改成了:dkrename 因为这个程序不单是这个用途的,所以抱歉不能提供源程序,这个能算领赏吗
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2013-4-23 01:04 | 显示全部楼层
pzweng 发表于 2013-6-5 07:48
我这个功能主要不是这个的,所以写的很复杂

我把命令改成了:dkrename
因为这个程序不单是这个用途的,所以抱歉不能提供源程序,这个能算领赏吗

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

能用就行呵呵  发表于 2013-6-6 19:00
回复

使用道具 举报

 楼主| 发表于 2013-4-23 01:07 | 显示全部楼层
用最土的方法写了一个。

(DEFUN C:TT2 ()
(print "请选择单个块")
(setq dbxz (ssget))
(setq dbzm (entget (SSNAME dbxz 0) ))
(setq dbkm (Cdr(assoc 2 dbzm )))
(setq dbkd (Cdr(assoc 10 dbzm )))
;(print (strcat "对比块名" dbkm))
(print "原基点")
(print  dbkd)
;(sssetfirst nil (ssget dbkd))
(command "EXPLODE" dbxz )
(setq xkname (getstring "请输入新块名:"))
(command "BLOCK" xkname dbkd "p" "")
(command "INSERT" xkname dbkd "" "" "")
)
回复

使用道具 举报

发表于 2013-4-23 08:26 | 显示全部楼层
(命令:test)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

能把 命令改一下吗,dkrename??  发表于 2013-6-4 12:57
有LISP吗?命令TEST不好啊。  发表于 2013-4-23 19:37
回复

使用道具 举报

发表于 2013-4-23 10:44 | 显示全部楼层
http://bbs.mjtd.com/thread-19105-1-1.html
你已经找到alin版主的程序了,为什么还要悬赏?
在alin版主提供的程序之前,我也是用土办法搞定。后来我就一直用align版主的程序了。
当年的土办法如下:
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;更改选定部分块的名字,对相同的其它块不影响,此程序有一定的危险性,操作失败可能删除选择的块
  3. ;只对选择集中第一个块的名字改变
  4. (defun C:ChangeSelectBlocksName ( / ssObjects strEntityName listEntityDXF strBlockName fblockpoint bool newblockname strBlockNameT)

  5. ;;;;;;;;;;;
  6. ;;;判断有没有某个块名,返回真假
  7. (defun BlockNameExist (BlockName / bn block_n  Bool)
  8. (SETQ block_n (TBLNEXT "block" T))
  9. (WHILE block_n  
  10.    (setq bn (CDR (ASSOC '2 block_n)))
  11.     (if (= bn BlockName) (setq Bool T))
  12.    (SETQ block_n (TBLNEXT "block"))
  13. )
  14. Bool
  15. )
  16. ;;;;;;;;;;


  17. (setq ssObjects (lt:ssget '("\n点选或窗选要改名的块:" ((0 . "insert") (100 . "AcDbBlockReference")))));拾取要更名的块
  18. (setq strEntityName (ssname ssObjects 0)); strEntityName,取得第1个对象名
  19. (setq listEntityDXF (entget strEntityName))
  20. (setq strBlockName (cdr (assoc 2 listEntityDXF)));第1个对象块名
  21. (setq fblockpoint (cdr (assoc 10 listEntityDXF)));第1个对象定位点
  22. (princ (strcat "你所选择的块,其块名为:" strBlockName))

  23. (setq bool T)
  24. (while bool
  25. (setq newblockname (getstring "\n 请输入规范的新块名:"))
  26. (if (BlockNameExist newblockname) (princ "你输入的块名已经存在!请重新取名.........") (setq bool nil))
  27. );end while

  28. (if newblockname (progn
  29. (command "_copybase" fblockpoint ssObjects "");带基点复制选定块
  30. (command "_erase" ssObjects "");删除选定块
  31. (setq strBlockNameT (strcat strBlockName "%"));暂时将选定块后缀加%
  32. (command "_rename" "B" strBlockName strBlockNameT);将选定块以外同名块暂时更名
  33. (command "zoom" "C" fblockpoint "")
  34. (command "_pasteclip" fblockpoint)
  35. (command "_rename" "B" strBlockName newblockname);选定块更名
  36. (command "_rename" "B" strBlockNameT strBlockName);将选定块以外同名块改回原来的名字
  37. );end progn
  38. (exit)
  39. );end if

  40. (gc)
  41. )
  42. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  43. ;;_________________________________________________________________

点评

想简化LISP~  发表于 2013-4-23 19:36
no function definition: LT:SSGET  发表于 2013-4-23 19:35
回复

使用道具 举报

 楼主| 发表于 2013-4-30 23:57 | 显示全部楼层
upupupupupupupupupup~
回复

使用道具 举报

 楼主| 发表于 2013-5-17 23:18 | 显示全部楼层
upupupupup~~~求G版来抓灌水
回复

使用道具 举报

 楼主| 发表于 2013-5-20 21:16 | 显示全部楼层
求代码。。
回复

使用道具 举报

 楼主| 发表于 2013-6-3 23:13 | 显示全部楼层
upupupupup
回复

使用道具 举报

发表于 2013-6-5 07:48 | 显示全部楼层
weiqi 发表于 2013-6-3 23:13
upupupupup

我这个功能主要不是这个的,所以写的很复杂

点评

弄一个 命令不是test的可以么。  发表于 2013-6-5 18:45
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 01:41 , Processed in 0.283004 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表