块按顺序编号-V2.4

张和平

第⑦次更新==V2.4=====================================



最好有探索者字体，或者将你常用的字体复制一份改成以下文件夹中的两种字体的名称：

第⑥次更新=======================================
更新至V2.1.0，加入了文字加框功能。  

1.           "\n######         块编号       #######"
   
2.           "\n######     VERSION 2.1.0    #######"
   
3.           "\n#######     peace [ZIAD]    #######"
   
4.           "\n#######      2013/04/09     #######"
   
5.           "\n##      zhptj1986@gmail.com      ##"
   
6.           "\n## blog.sina.com.cn/peacelvirene ##"
   
7.           "\n## Copyright (C) 2012-2013 ZIAD  ##"
   
8.           "\n##      All Rights Reserved      ##"
   
9.           "\n***********************************"
   
10.           "\n1、块编号命令：BN；"
    
11.           "\n2、可选择起始编号、编号前缀及编号顺"
    
12.           "\n   序。"
    
13.           "\n***********************************"
    
14.           "\nV2.1.0更新说明(2013/04/09)："
    
15.           "\n1、加入了文字加框功能，有不加框、加"
    
16.           "\n   圆框、加矩形框、加圆角矩形框和加"
    
17.           "\n   椭圆框五种模式；"
    
18.           "\n2、加入了错误处理功能，但是还不够完"
    
19.           "\n   善，以后小版本中慢慢完善。"
    
20.           "\n***********************************"

复制代码

第⑤次更新=======================================
          "\n######         块编号       #######"
          "\n######     VERSION 2.0.0    #######"
          "\n#######     peace [ZIAD]    #######"
          "\n#######      2013/04/08     #######"
          "\n##      zhptj1986@gmail.com      ##"
          "\n## blog.sina.com.cn/peacelvirene ##"
          "\n## Copyright (C) 2012-2013 ZIAD  ##"
          "\n##      All Rights Reserved      ##"
          "\n***********************************"
          "\n1、块编号命令：BN；"
          "\n2、可选择起始编号、编号前缀及编号顺"
          "\n   序。"
          "\n***********************************"
          "\nV2.0.0更新说明(2013/04/08)："
          "\n1、全面改版，加入了参数设置对话框，"
          "\n   不必每次都设置一遍参数，提高了绘"
          "\n   图效率；"
          "\n2、此版在功能上与前一版没有大差别，"
          "\n   只是让绘图步骤更加直观；"
          "\n3、参数设置界面加入了文字加框的一些"
          "\n   选项，但是目前尚不起作用，将在下"
          "\n   一版中加入这个功能。"
          "\n***********************************"


第④次更新=======================================
完善了不少内容，更新说明如下：
;"***********************************"
;"V1.3.0更新说明："
;"1、文字随块一起转动，并调整方向使得"
;"   视图上比较舒服；"
;"***********************************"
;"V1.2.0更新说明："
;"1、编号显示三位数，不足三位的前面以"
;"   0补足；"
;"2、修改原先有种编号顺序不能用的bug。"
;"3、增加编号顺序至五种；"
;"4、不强制前缀；"
;"***********************************"
;"V1.1.0更新说明："
;"1、更新了获取块外框角点的函数，解决"
;"   编号位置不准的bug；"
;"***********************************"

总体效果如下图所示：

放上V1.3.0源码：


第③次更新=======================================
放上V1.1.0源码

第②次更新=======================================
在某些块上会出现定位不准的bug，现在已经找到更为强大的获取块边框角点的函数，这个bug基本解决了，随后更新上新的源码。
另外，有个问题，我在运行时，虽然是正确的，但是在command栏会跳出好多下面的提示：

1. 未知命令“BN”。按 F1 查看帮助。
   
2. 未知命令“BN”。按 F1 查看帮助。
   
3. 未知命令“BN”。按 F1 查看帮助。
   
4. 未知命令“BN”。按 F1 查看帮助。
   
5. 未知命令“BN”。按 F1 查看帮助。
   
6. 未知命令“BN”。按 F1 查看帮助。
   
7. 未知命令“BN”。按 F1 查看帮助。
   
8. 未知命令“BN”。按 F1 查看帮助。
   
9. 未知命令“BN”。按 F1 查看帮助。
   
10. 未知命令“BN”。按 F1 查看帮助。
    
11. 未知命令“BN”。按 F1 查看帮助。
    
12. 未知命令“BN”。按 F1 查看帮助。
    
13. 未知命令“BN”。按 F1 查看帮助。
    
14. 未知命令“BN”。按 F1 查看帮助。
    
15. 未知命令“BN”。按 F1 查看帮助。
    
16. 未知命令“BN”。按 F1 查看帮助。

复制代码

第①次更新=======================================其中借用了论坛上一些大神们的函数，在源码中也标出了。。

源码贴上：

2. ;"######         块编号       #######"
   
3. ;"######     VERSION 1.0.0    #######"
   
4. ;"#######     peace [ZIAD]    #######"
   
5. ;"#######      2013/03/28     #######"
   
6. ;"##      zhptj1986@gmail.com      ##"
   
7. ;"## blog.sina.com.cn/peacelvirene ##"
   
8. ;"## Copyright (C) 2012-2013 ZIAD  ##"
   
9. ;"##      All Rights Reserved      ##"
   
10. ;"***********************************"
    
11. ;"1、块编号命令：BN；"
    
12. ;"2、可选择起始编号、编号前缀及编号顺"
    
13. ;"   序。"
    
14. ;"***********************************"
    
15. ;"欢迎使用！欢迎提出意见和建议！"
    
16. ;"***********************************"
    
17. (DEFUN C:BN(/ en vlay blockname i m end minp minp maxp minx maxx miny maxy pmin pmax
    
18.               startnum frontname midplst vcmd nummode)
    
19.   (vl-load-com)
    
20.   (princ "\n块编号,by Peace ZIAD。有问题请发邮件至zhptj1986@gmail.com")
    
21.   (setq vlay (getvar "CLAYER"))
    
22.   (setq vcmd (getvar "cmdecho"))
    
23.   (setq vlup(getvar "luprec"))
    
24.   (setvar "cmdecho" 0)
    
25.   (setvar "luprec" 0)
    
26.   (bnlayermake "车位编号" 2 "continuous")
    
27.   (setq startnum "")
    
28.   (setq frontname "")
    
29.   (setq nummode "")
    
30.   (setq startnum (getstring "\n ①请输入起始编号[1]:"))
    
31.   (if (= startnum "")(setq startnum 1)(setq startnum (atoi startnum)))
    
32.   (setq frontname (getstring "\n ②请输入前缀[car]:"))
    
33.   (if (= frontname "")(setq frontname "car"))
    
34.   (setq nummode (getstring "\n ③编号顺序:由上到下由左到右(A)/由下到上由左到右(B)[A]:"))
    
35.   (if (= nummode "")(setq nummode "A")
    
36.     (if (= (strcase nunmode) "B")        ;将字符转换成大写
    
37.       (setq nunmode "B")
    
38.       (setq nunmode "A")
    
39.     )
    
40.   )
    
41.   ;(setq blockname "")
    
42.   ;(while (= blockname "")
    
43.     (setq blockname (cdr (assoc 2 (entget (car (entsel "\n ④请拾取要编号的块名:"))))))
    
44.   ;)
    
45.   (PRINC (strcat "\n**块名选择成功，需要编号的块名为"" blockname ""\n ⑤选择要编号的块："))
    
46.   (while(null(setq en (ssget (list'(0 . "insert")(cons 2 blockname))))))
    
47.   (setq i 1)
    
48.   (setq midplst nil)
    
49.   (repeat (setq m (sslength en))
    
50.     (setq end (ssname en (1- i)))
    
51.     (bngetmidp)
    
52.     (setq midplst (cons midp midplst))
    
53.     (setq i (1+ i))
    
54.   )
    
55.   (if (= nummode "A")
    
56.     (setq midplst (bnsort-xy midplst '(< >)))
    
57.     (setq midplst (bnsort-xy midplst '(< <)))
    
58.   )
    
59.   (setq i 1)
    
60.   (repeat m
    
61.     (setq midp (nth (1- i) midplst))
    
62.     (command "text" "j" "m" midp 300 "" (strcat frontname (rtos (1- (+ startnum i)))) "")
    
63.     (setq i (1+ i))
    
64.   )
    
65.   (setvar "CLAYER" vlay)
    
66.   (setvar "cmdecho" vcmd)
    
67.   (setvar "luprec" vlup)
    
68.   (princ (strcat "\n[BN]块编号顺利完成任务!共编号" (rtos m) "个!最大编号=" (rtos (1- (+ m startnum)))))
    
69.   (princ)
    
70.   
    
71. )
    
72. 
    
73. (defun bngetmidp()
    
74. (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
    
75. (setq minp (vlax-safearray->list minp)
    
76.        maxp (vlax-safearray->list maxp))
    
77. (setq minx (car minp)
    
78.        maxx (car maxp)
    
79.        miny (cadr minp)
    
80.        maxy (cadr maxp))
    
81. (setq pmin (list minx miny)
    
82.        pmax (list maxx maxy))
    
83. (setq midp (mapcar '* '(0.5 0.5) (mapcar '+ pmin pmax)))
    
84. )
    
85. 
    
86. (defun bnlayermake (name color ltype)
    
87.   (command "layer" "m" name "c" color name "l" ltype name "")
    
88. )
    
89. 
    
90. ;来源http://bbs.mjtd.com/thread-9546-1-1.html[提供者：aeo000000]
    
91. ;(sort-xy li '(>))  只按x由大到小
    
92. ;(sort-xy li '(<))  只按x由小到大
    
93. ;(sort-xy li '(nil >))    只按y由大到小
    
94. ;(sort-xy li '(nil <))    只按y由小到大
    
95. ;其余x和y组合的情况类推
    
96. (defun bnsort-xy (li how / a)
    
97. (if(setq a(car how))(setq li(vl-sort li '(lambda(x y)((eval a)(car x)(car y))))))
    
98. (if(setq a(cadr how))(setq li(vl-sort li '(lambda(x y)((eval a)(cadr x)(cadr y))))))
    
99. li
    
100. )
     
101. 
     
102. (princ "\n块编号，命令BN")
     
103. (princ)

;"######         块编号       #######"<br /> ;"######     VERSION 1.0.0    #######"<br /> ;"#######     peace [ZIAD]    #######"<br /> ;"#######      2013/03/28     #######"<br /> ;"##      zhptj1986@gmail.com      ##"<br /> ;"## blog.sina.com.cn/peacelvirene ##"<br /> ;"## Copyright (C) 2012-2013 ZIAD  ##"<br /> ;"##      All Rights Reserved      ##"<br /> ;"***********************************"<br /> ;"1、块编号命令：BN；"<br /> ;"2、可选择起始编号、编号前缀及编号顺"<br /> ;"   序。"<br /> ;"***********************************"<br /> ;"欢迎使用！欢迎提出意见和建议！"<br /> ;"***********************************"<br /> (DEFUN C:BN(/ en vlay blockname i m end minp minp maxp minx maxx miny maxy pmin pmax<br />               startnum frontname midplst vcmd nummode)<br />   (vl-load-com)<br />   (princ "\n块编号,by Peace ZIAD。有问题请发邮件至zhptj1986@gmail.com")<br />   (setq vlay (getvar "CLAYER"))<br />   (setq vcmd (getvar "cmdecho"))<br />   (setq vlup(getvar "luprec"))<br />   (setvar "cmdecho" 0)<br />   (setvar "luprec" 0)<br />   (bnlayermake "车位编号" 2 "continuous")<br />   (setq startnum "")<br />   (setq frontname "")<br />   (setq nummode "")<br />   (setq startnum (getstring "\n ①请输入起始编号[1]:"))<br />   (if (= startnum "")(setq startnum 1)(setq startnum (atoi startnum)))<br />   (setq frontname (getstring "\n ②请输入前缀[car]:"))<br />   (if (= frontname "")(setq frontname "car"))<br />   (setq nummode (getstring "\n ③编号顺序:由上到下由左到右(A)/由下到上由左到右(B)[A]:"))<br />   (if (= nummode "")(setq nummode "A")<br />     (if (= (strcase nunmode) "B")        ;将字符转换成大写<br />       (setq nunmode "B")<br />       (setq nunmode "A")<br />     )<br />   )<br />   ;(setq blockname "")<br />   ;(while (= blockname "")<br />     (setq blockname (cdr (assoc 2 (entget (car (entsel "\n ④请拾取要编号的块名:"))))))<br />   ;)<br />   (PRINC (strcat "\n**块名选择成功，需要编号的块名为"" blockname ""\n ⑤选择要编号的块："))<br />   (while(null(setq en (ssget (list'(0 . "insert")(cons 2 blockname))))))<br />   (setq i 1)<br />   (setq midplst nil)<br />   (repeat (setq m (sslength en))<br />     (setq end (ssname en (1- i)))<br />     (bngetmidp)<br />     (setq midplst (cons midp midplst))<br />     (setq i (1+ i))<br />   )<br />   (if (= nummode "A")<br />     (setq midplst (bnsort-xy midplst '(< >)))<br />     (setq midplst (bnsort-xy midplst '(< <)))<br />   )<br />   (setq i 1)<br />   (repeat m<br />     (setq midp (nth (1- i) midplst))<br />     (command "text" "j" "m" midp 300 "" (strcat frontname (rtos (1- (+ startnum i)))) "")<br />     (setq i (1+ i))<br />   )<br />   (setvar "CLAYER" vlay)<br />   (setvar "cmdecho" vcmd)<br />   (setvar "luprec" vlup)<br />   (princ (strcat "\n[BN]块编号顺利完成任务!共编号" (rtos m) "个!最大编号=" (rtos (1- (+ m startnum)))))<br />   (princ)<br />   <br /> )<br /> <br /> (defun bngetmidp()<br /> (vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)<br /> (setq minp (vlax-safearray->list minp)<br />        maxp (vlax-safearray->list maxp))<br /> (setq minx (car minp)<br />        maxx (car maxp)<br />        miny (cadr minp)<br />        maxy (cadr maxp))<br /> (setq pmin (list minx miny)<br />        pmax (list maxx maxy))<br /> (setq midp (mapcar '* '(0.5 0.5) (mapcar '+ pmin pmax)))<br /> )<br /> <br /> (defun bnlayermake (name color ltype)<br />   (command "layer" "m" name "c" color name "l" ltype name "")<br /> )<br /> <br /> ;来源http://bbs.mjtd.com/thread-9546-1-1.html[提供者：aeo000000]<br /> ;(sort-xy li '(>))  只按x由大到小<br /> ;(sort-xy li '(<))  只按x由小到大<br /> ;(sort-xy li '(nil >))    只按y由大到小<br /> ;(sort-xy li '(nil <))    只按y由小到大<br /> ;其余x和y组合的情况类推<br /> (defun bnsort-xy (li how / a)<br /> (if(setq a(car how))(setq li(vl-sort li '(lambda(x y)((eval a)(car x)(car y))))))<br /> (if(setq a(cadr how))(setq li(vl-sort li '(lambda(x y)((eval a)(cadr x)(cadr y))))))<br /> li<br /> )<br /> <br /> (princ "\n块编号，命令BN")<br /> (princ)

1. 
   

复制代码

效果如下：

黑洞—杜明智

张和平 发表于 2013-4-1 10:30
我怎么没有找到cal这个命令呢？请问能给出这个命令的详细格式及作用吗？

CAL 命令 ：计算数学和几何表达式

通常，程序假定所有坐标都是相对于当前 UCS 的。 可以使用下列函数在 UCS 和 WCS 之间转换点的坐标值。

w2u(p1)

将以 WCS 表示的点 p1 转换到当前 UCS 中。

u2w(p1)

将以当前 UCS 表示的点 p1 转换到 WCS 中。

可使用 w2u 查找用当前的 UCS 表示的 WCS 的原点：

w2u([0,0,0])

Aries

求助  顺序能不能加上功能   上下分行，行左起啊？    就是第一排12345   第二排6789 10   F:\微信公众号久讑學習社\天正图转换纸演示\编号.png

hao3ren

  (command "text" "j" "m" midp 300 "" (strcat frontname (rtos (1- (+ startnum i)))) "")
修改成  (command "text" "j" "m" midp 300 "" (strcat frontname (rtos (1- (+ startnum i)))))

张和平

hao3ren 发表于 2013-3-28 12:11
(command "text" "j" "m" midp 300 "" (strcat frontname (rtos (1- (+ startnum i)))) "")
修改成  (co ...

OK...额，，居然忘记这个地方了，，，现在好了，，谢谢！

黑洞—杜明智

最近正在学习对车位进行编号呢，过来学习一下！实际操作中的编号文字方向应该是同一方向，而不愿其随着图块转方向！

张和平

黑洞—杜明智 发表于 2013-3-31 21:46
最近正在学习对车位进行编号呢，过来学习一下！实际操作中的编号文字方向应该是同一方向，而不愿其随着图块 ...

这个简单，通过简单修改便可增加选项，选择文字是否随图块旋转

黑洞—杜明智

张和平 发表于 2013-3-31 22:54
这个简单，通过简单修改便可增加选项，选择文字是否随图块旋转

1. ;;取得对象要插入编号的点->对象的中点
   
2. (setq obj (vlax-ename->vla-object en))
   
3. ;; 得到包围框   
   
4. (setq avc (vla-GetBoundingBox Obj 'minpt 'maxpt))   
   
5. (setq minPt (vlax-safearray->list minPt))   
   
6. (setq maxPt (vlax-safearray->list maxPt))   
   
7. (setq minPt (cal "w2u(minPt)"))   
   
8. (setq maxPt (cal "w2u(maxPt)"))   
   
9. (setq PtCen        (list (/ (+ (car minpt) (car maxpt)) 2)                      (/ (+ (cadr minpt) (cadr maxpt)) 2)                )    )
   

;;取得对象要插入编号的点->对象的中点<br /> (setq obj (vlax-ename->vla-object en))<br /> ;; 得到包围框   <br /> (setq avc (vla-GetBoundingBox Obj 'minpt 'maxpt))   <br /> (setq minPt (vlax-safearray->list minPt))   <br /> (setq maxPt (vlax-safearray->list maxPt))   <br /> (setq minPt (cal "w2u(minPt)"))   <br /> (setq maxPt (cal "w2u(maxPt)"))   <br /> (setq PtCen        (list (/ (+ (car minpt) (car maxpt)) 2)                      (/ (+ (cadr minpt) (cadr maxpt)) 2)                )    )<br />

一直困惑我的UCS与WCS之间的转换，看了很多矩阵转换函数，无奈数学基础差，就在刚刚突然发现了CAD原有的CAL命令，一下子解决了我的大问题。运用还不成熟，不过顺着搞下去也许有成效。也要谢谢你的程序带给我的灵感。

张和平

黑洞—杜明智 发表于 2013-3-31 23:10
一直困惑我的UCS与WCS之间的转换，看了很多矩阵转换函数，无奈数学基础差，就在刚刚突然发现了CAD原有的C ...

我怎么没有找到cal这个命令呢？请问能给出这个命令的详细格式及作用吗？

张和平

黑洞—杜明智 发表于 2013-4-1 14:16
CAL 命令 ：计算数学和几何表达式

通常，程序假定所有坐标都是相对于当前 UCS 的。 可以使用下列函数在 ...

这个好牛逼啊。。。。