【CC】序号标注带引线

huxu823

2. 
   
3. (defun c:cc()
   
4. (setvar "cmdecho" 0)
   
5. (if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
   
6. (setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
   
7. (setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))
   
8. (setq n(getint  (strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))
   
9. (setq b(getint  (strcat "\n序号位数[前面补0]<" (itoa (cadddr ccvar)) ">:")))
   
10. (initget 0 "Y N")
    
11. (setq k (getkword (strcat "\n是否设置前缀(Y)/(N)<" (nth 4 ccvar)">:")))
    
12. (if (= k nil)(setq k (nth 4 ccvar)))
    
13. (setq s "" marks (nth 5 ccvar))
    
14. (if (= k "Y") (progn
    
15. (setq s (getstring (strcat "\n设置前缀<" marks ">:")))
    
16. (if (= s "")(setq s marks)(setq marks s))
    
17. ))
    
18. (if (= r nil)(setq r (car ccvar)))
    
19. (if (= h nil)(setq h (cadr ccvar)))
    
20. (if (= n nil)(setq n (caddr ccvar)))
    
21. (if (= b nil)(setq b (cadddr ccvar)))
    
22. (setq ss "" bb (itoa n))
    
23. (while (setq pt (getpoint "\n指定起点:"))
    
24. (setq ceo nil)
    
25. (repeat (- b (strlen bb)) (setq ss (strcat ss "0")))
    
26. (if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))
    
27. (command "text" "J" "mc" pt h "" (strcat s ss bb))
    
28. (setq teo (entget (entlast)))
    
29. (command "leader" pt (polar pt (/ pi 4) r)  "" "" "n")
    
30. (setq leo (entget (entlast)))
    
31. (setq p1 (cdr (assoc 10 leo)) k 1)
    
32. (while (/= k 3)
    
33. (setq p (grread T))
    
34. (setq k (car p) p (cadr p))
    
35. (if (> r 0) (progn
    
36. (setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
    
37. (entmod ceo)
    
38. ))
    
39. (setq teo (subst (cons 11 p) (assoc 11 teo) teo))
    
40. (entmod teo)
    
41. (setq p (polar p (angle p p1) r))
    
42. (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
    
43. (if (> (distance p p1) 0.0) (entmod leo))
    
44. )
    
45. (setq n (1+ n) ss "" bb (itoa n))
    
46. )
    
47. (setq ccvar (list r h n b k marks))
    
48. (setvar "cmdecho" 1)
    
49. (princ)
    
50. )
    
51. (princ "\n命令:CC")
    
52. (prin1)

<br /> (defun c:cc()<br /> (setvar "cmdecho" 0)<br /> (if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))<br /> (setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))<br /> (setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))<br /> (setq n(getint  (strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))<br /> (setq b(getint  (strcat "\n序号位数[前面补0]<" (itoa (cadddr ccvar)) ">:")))<br /> (initget 0 "Y N")<br /> (setq k (getkword (strcat "\n是否设置前缀(Y)/(N)<" (nth 4 ccvar)">:")))<br /> (if (= k nil)(setq k (nth 4 ccvar)))<br /> (setq s "" marks (nth 5 ccvar))<br /> (if (= k "Y") (progn<br /> (setq s (getstring (strcat "\n设置前缀<" marks ">:")))<br /> (if (= s "")(setq s marks)(setq marks s))<br /> ))<br /> (if (= r nil)(setq r (car ccvar)))<br /> (if (= h nil)(setq h (cadr ccvar)))<br /> (if (= n nil)(setq n (caddr ccvar)))<br /> (if (= b nil)(setq b (cadddr ccvar)))<br /> (setq ss "" bb (itoa n))<br /> (while (setq pt (getpoint "\n指定起点:"))<br /> (setq ceo nil)<br /> (repeat (- b (strlen bb)) (setq ss (strcat ss "0")))<br /> (if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))<br /> (command "text" "J" "mc" pt h "" (strcat s ss bb))<br /> (setq teo (entget (entlast)))<br /> (command "leader" pt (polar pt (/ pi 4) r)  "" "" "n")<br /> (setq leo (entget (entlast)))<br /> (setq p1 (cdr (assoc 10 leo)) k 1)<br /> (while (/= k 3)<br /> (setq p (grread T))<br /> (setq k (car p) p (cadr p))<br /> (if (> r 0) (progn<br /> (setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))<br /> (entmod ceo)<br /> ))<br /> (setq teo (subst (cons 11 p) (assoc 11 teo) teo))<br /> (entmod teo)<br /> (setq p (polar p (angle p p1) r))<br /> (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))<br /> (if (> (distance p p1) 0.0) (entmod leo))<br /> )<br /> (setq n (1+ n) ss "" bb (itoa n))<br /> )<br /> (setq ccvar (list r h n b k marks))<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )<br /> (princ "\n命令:CC")<br /> (prin1)

;;此程序有2个BUG：
;;1、选用的字体样式的字高必须设置为0，否则标注错误，望高手修复！
;;2、引线的箭头始终显示为1:1的绘图比例，比如字高和圆圈半径放大了100倍，引线箭头不会放大100倍。

飞雪神光

1. (defun c:cc(/ b bb ceo h k leo marks n p p1 pt r s ss teo)
   
2.         (setvar "cmdecho" 0)
   
3.         (if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
   
4.         (setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
   
5.         (setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))
   
6.         (setq n(getint  (strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))
   
7.         (setq b(getint  (strcat "\n序号位数(前面补0)<" (itoa (cadddr ccvar)) ">:")))
   
8.         (initget 0 "Y N")
   
9.         (setq k (getkword (strcat "\n前缀[添加前缀(Y)/不加前缀(N)]<" (nth 4 ccvar)">:")))
   
10.         (if (= k nil)(setq k (nth 4 ccvar)))
    
11.         (setq s "" marks (nth 5 ccvar))
    
12.         (if (= k "Y")
    
13.                 (progn
    
14.                         (setq s (getstring (strcat "\n设置前缀<" marks ">:")))
    
15.                         (if (= s "")(setq s marks)(setq marks s))
    
16.                 )
    
17.         )
    
18.         (if (= r nil)(setq r (car ccvar)))
    
19.         (if (= h nil)(setq h (cadr ccvar)))
    
20.         (if (= n nil)(setq n (caddr ccvar)))
    
21.         (if (= b nil)(setq b (cadddr ccvar)))
    
22.         (setq ccvar (list r h n b k marks))
    
23.         (setq ss "" bb (itoa n))
    
24.         (while (setq pt (getpoint "\n指定起点:"))
    
25.                 (setq ceo nil)
    
26.                 (repeat (- b (strlen bb)) (setq ss (strcat ss "0")))
    
27.                 (if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))
    
28.                 (entmake(list '(0 . "text")'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 (strcat s ss bb))(cons 40 h)'(6 . "Continuous")'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))
    
29.                 (setq teo (entget (entlast)))
    
30.                 (entmake (list '(0 . "LEADER")'(100 . "AcDbEntity")'(100 . "AcDbLeader")(cons 10 pt) (cons 10 (polar pt (* pi 0.25) r))))
    
31.                 (setq leo (entget (entlast)))
    
32.                 (setq p1 (cdr (assoc 10 leo)) k 1)
    
33.                 (while (/= k 3)
    
34.                         (setq p (grread T))
    
35.                         (setq k (car p) p (cadr p))
    
36.                         (if (> r 0)
    
37.                                 (progn
    
38.                                         (setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
    
39.                                         (entmod ceo)
    
40.                                 )
    
41.                         )
    
42.                         (setq teo (subst (cons 11 p) (assoc 11 teo) teo))
    
43.                         (entmod teo)
    
44.                         (setq p (polar p (angle p p1) r))
    
45.                         (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
    
46.                         (if (> (distance p p1) 0.0) (entmod leo))
    
47.                 )
    
48.                 (setq n (1+ n) ss "" bb (itoa n))
    
49.         )
    
50.         (setvar "cmdecho" 1)
    
51.         (princ)
    
52. )
    
53. (princ "\n命令:CC")
    
54. (princ)

(defun c:cc(/ b bb ceo h k leo marks n p p1 pt r s ss teo)<br />         (setvar "cmdecho" 0)<br />         (if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))<br />         (setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))<br />         (setq h(getreal (strcat "\n输入字高<" (rtos (cadr ccvar)) ">:")))<br />         (setq n(getint  (strcat "\n起始序号<" (itoa (caddr ccvar)) ">:")))<br />         (setq b(getint  (strcat "\n序号位数(前面补0)<" (itoa (cadddr ccvar)) ">:")))<br />         (initget 0 "Y N")<br />         (setq k (getkword (strcat "\n前缀[添加前缀(Y)/不加前缀(N)]<" (nth 4 ccvar)">:")))<br />         (if (= k nil)(setq k (nth 4 ccvar)))<br />         (setq s "" marks (nth 5 ccvar))<br />         (if (= k "Y")<br />                 (progn<br />                         (setq s (getstring (strcat "\n设置前缀<" marks ">:")))<br />                         (if (= s "")(setq s marks)(setq marks s))<br />                 )<br />         )<br />         (if (= r nil)(setq r (car ccvar)))<br />         (if (= h nil)(setq h (cadr ccvar)))<br />         (if (= n nil)(setq n (caddr ccvar)))<br />         (if (= b nil)(setq b (cadddr ccvar)))<br />         (setq ccvar (list r h n b k marks))<br />         (setq ss "" bb (itoa n))<br />         (while (setq pt (getpoint "\n指定起点:"))<br />                 (setq ceo nil)<br />                 (repeat (- b (strlen bb)) (setq ss (strcat ss "0")))<br />                 (if (> r 0) (progn (command "circle" pt r) (setq ceo (entget (entlast)))))<br />                 (entmake(list '(0 . "text")'(50 . 0.0) (cons 10 pt)(cons 11 pt)(cons 1 (strcat s ss bb))(cons 40 h)'(6 . "Continuous")'(72 . 1)'(210 0.0 0.0 1.0)'(100 . "AcDbText")'(73 . 2)))<br />                 (setq teo (entget (entlast)))<br />                 (entmake (list '(0 . "LEADER")'(100 . "AcDbEntity")'(100 . "AcDbLeader")(cons 10 pt) (cons 10 (polar pt (* pi 0.25) r))))<br />                 (setq leo (entget (entlast)))<br />                 (setq p1 (cdr (assoc 10 leo)) k 1)<br />                 (while (/= k 3)<br />                         (setq p (grread T))<br />                         (setq k (car p) p (cadr p))<br />                         (if (> r 0)<br />                                 (progn<br />                                         (setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))<br />                                         (entmod ceo)<br />                                 )<br />                         )<br />                         (setq teo (subst (cons 11 p) (assoc 11 teo) teo))<br />                         (entmod teo)<br />                         (setq p (polar p (angle p p1) r))<br />                         (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))<br />                         (if (> (distance p p1) 0.0) (entmod leo))<br />                 )<br />                 (setq n (1+ n) ss "" bb (itoa n))<br />         )<br />         (setvar "cmdecho" 1)<br />         (princ)<br /> )<br /> (princ "\n命令:CC")<br /> (princ)

Qwer1243

飞雪神光 发表于 2024-4-9 14:21
替换这一段

2.                         (if (> (distance p p1) 0.0)
   
3.                                 (progn
   
4.                                         (entmod leo)
   
5.                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) r)
   
6.                                 )
   
7.                         )

                        (if (> (distance p p1) 0.0)<br />                                 (progn<br />                                         (entmod leo)<br />                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) r)<br />                                 )<br />                         )

你修改的代码，正好是我想要的，这一段好像应该这样改才合适

飞雪神光

huxu823 发表于 2024-4-9 13:17
感谢兄弟，试了一下，第一个BUG解决了，第二个还是老样子，引线的小圆点没有根据圆圈半径或者字高而放大 ...

替换这一段

1. (if (> (distance p p1) 0.0)
   
2.                                 (progn
   
3.                                         (entmod leo)
   
4.                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object lety) r)
   
5.                                 )
   
6.                         )

(if (> (distance p p1) 0.0)<br />                                 (progn<br />                                         (entmod leo)<br />                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object lety) r)<br />                                 )<br />                         )

huxu823

飞雪神光 发表于 2024-4-9 11:38

感谢兄弟，试了一下，第一个BUG解决了，第二个还是老样子，引线的小圆点没有根据圆圈半径或者字高而放大相应的倍数

liuhe

我给别人定制，多重引线自带反应器。你的单重引线，还没有反应器，限制太多了

huxu823

Qwer1243 发表于 2024-5-2 21:21
你修改的代码，正好是我想要的，这一段好像应该这样改才合适

试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小圆点了！
要如何修改代码，才能让标注的引线小圆点不受当前标注样式的影响？

Qwer1243

huxu823 发表于 2024-5-5 10:54
试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小 ...

会有影响吗，圆点的大小不是由你输入的圆大小确定的吗？
(if (= ccvar nil)(setq ccvar (list 2.5 3 1 1 "N" "")))
(setq r(getreal (strcat "\n圆圈半径<" (rtos (car ccvar)) ">:")))
从最开始，你的r就定死了

Qwer1243

huxu823 发表于 2024-5-5 10:54
试了下，可以用，但是也有问题，如果当前的标注样式的全局比例假设是1:100的，标出来的引线反而看不见小 ...

我想了一下，你说得应该是全局标注比例，获取系统的比例参数乘上r应该就解决了

1.                         (if (> (distance p p1) 0.0)
   
2.                                 (progn
   
3.                                         (entmod leo)
   
4.                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) (* r (getvar "DIMSCALE")))
   
5.                                 )
   
6.                         )

                        (if (> (distance p p1) 0.0)<br />                                 (progn<br />                                         (entmod leo)<br />                                         (vla-put-ArrowheadSize (Vlax-Ename->Vla-Object (cdar leo)) (* r (getvar "DIMSCALE")))<br />                                 )<br />                         )

huxu823

Qwer1243 发表于 2024-5-5 15:39
我想了一下，你说得应该是全局标注比例，获取系统的比例参数乘上r应该就解决了

我说的小圆点，不是指数字外的那个圆圈，是引线的箭头小圆点。
确实跟当前的全局比例有关，比如圆半径默认是2.5，字高默认是3，我输入的250和300，相当于放大了100倍，但是如果当前的全局比例是1，引线的小圆点箭头就会非常小，与字高不匹配。而此时我希望引线的小圆点的大小应该是放大了100倍的关系，相当于全局比例100时的小圆点的大小。