【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)

huxu823

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

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

飞雪神光

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 />                         )

liuhe

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