[源码] 导线型号及档距标注

admin1

1. (defun C:bzdj(/)
   
2.        
   
3.         (prompt "\n请选择多段线进行标注")
   
4.         (setq dotlen (getint " \n请输入小数位数(直接跳过默认为0):"))
   
5.         (setq texthigh (getreal " \n请输入字高(直接跳过默认为3):"))
   
6.         (setq textcolor (getint " \n请输入颜色代码(直接跳过默认为3[绿色]):"))
   
7. 
   
8.         (if (= nil dotlen) (setq dotlen 0))
   
9.         (if (= nil texthigh) (setq texthigh 3))
   
10.         (if (= nil textcolor) (setq textcolor 3))
    
11. 
    
12.         (dxbz "m" texthigh textcolor dotlen)
    
13. )
    
14. 
    
15. (defun C:bzxh(/)
    
16.        
    
17.         (prompt "\n请选择多段线进行标注")
    
18.         (setq linename (getstring " \n请输入导线型号(直接跳过默认为LGJ-25)："))
    
19.         (setq texthigh (getreal " \n请输入字高(直接跳过默认为3):"))
    
20.         (setq textcolor (getint " \n请输入颜色代码(直接跳过默认为3[绿色]):"))
    
21.        
    
22.         (if (= "" linename) (setq linename "LGJ-25"))
    
23.         (if (= nil texthigh) (setq texthigh 3))
    
24.         (if (= nil textcolor) (setq textcolor 3))
    
25. 
    
26.         (dxbz linename texthigh textcolor 0)
    
27. )
    
28. 
    
29. 
    
30. (defun dxbz (text texthigh textcolor dotlen / ent lis);多段线每段线中心标注本段线长
    
31. 
    
32.         (setq sset nil)
    
33.         (while (equal sset nil)
    
34.                 (setq sset (ssget (list
    
35.                                                                                                 (cons 0 "LWPOLYLINE" )
    
36.                                                                                                 ;(cons 62 7 );过滤条件颜色为白色
    
37.                                                                                         )))
    
38.         )
    
39.   ;(setq FontStyle (GetFontStyle "XX-宋体"))
    
40.   (setq FontStyle "XX-宋体")
    
41.         (setq i -1)
    
42.        
    
43.         (while (setq ent (ssname sset (setq i (1+ i))))
    
44.                 (mapcar '
    
45.                         (lambda (x)
    
46.                                 (if (= "m" text) (setq textvalue (strcat (car x) "m")) (setq textvalue linename))
    
47.                                 (if (> (atof (car x)) 5.0)
    
48.                                                                         (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
    
49.                                                                          (cons 7 FontStyle)
    
50.                                                                          (cons 1 textvalue)
    
51.                                                                          (cons 10
    
52.                                                                                  (polar (cadr x) (+ (last x) (*(if (= "m" text) -1 1) (/ pi 2))) (/ texthigh 2)))
    
53.                                                                          (cons 71 (if (= "m" text) 2 8))
    
54.                                                                          (cons 62 textcolor)
    
55.                                                                          (cons 40 texthigh)
    
56.                                                                          (cons 11 (cadr x))
    
57.                                                                          (cons 50 (last x))))       
    
58.                                 )
    
59.                         )
    
60.                         (mapcar '
    
61.                                 (lambda (x)
    
62.                                         (list
    
63.                                                 (rtos (distance (car x) (cadr x)) 2 dotlen)
    
64.                                                 (mapcar '* '(0.5 0.5) (mapcar '+ (car x) (cadr x)))
    
65.                                                 (angle (car x) (cadr x))
    
66.                                                 ;(- (rem (+ (angle (car x) (cadr x)) (* 0.25 pi)) pi) (* 0.25 pi))
    
67.                                         ))
    
68.                                 (mapcar 'list (setq lis (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))) (cdr lis))
    
69.                         ))
    
70.                 (princ)
    
71.         )
    
72. )

复制代码