多段线长度批量标注

树櫴希德

1. (defun spbz (pt1 pt2 pt3 /  )
   
2. 
   
3.      
   
4. ;12、倾斜标注  
   
5. (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 pt1) '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")
   
6.    (cons 13 pt2) (cons 14 pt3)
   
7.     )
   
8.   )
   
9. )
   
10. 
    
11. 
    
12. (DEFUN BFZ (pzx / i  ll lll pzxa)
    
13. ;(setq pzx '(1 2 3 4))
    
14. (setq i 0) (setq ll '())
    
15. (repeat (- (length pzx)1)
    
16.    (setq lll (list (nth i pzx) (nth (+ i 1) pzx)  ))
    
17.   (setq pzxa (cons lll pzxa))
    
18.   (setq i (1+ i))
    
19. )
    
20. pzxa
    
21. )
    
22. 
    
23. 
    
24. ;(setq en (car (entsel "\n请选择需要标注的线段")))
    
25. 
    
26. 
    
27. 
    
28. 
    
29. (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))
    
30. 
    
31. (mapcar  '(lambda (x) (spbz (polar (car x) (+(angle (car x) (cadr x))(* 0.5 pi)) 1.5)
    
32.   (car x) (cadr x))
    
33. 
    
34.       )   (bfz zbb))

(defun spbz (pt1 pt2 pt3 /  )<br /> <br />      <br /> ;12、倾斜标注  <br /> (entmake (list '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension") (cons 10 pt1) '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")<br />    (cons 13 pt2) (cons 14 pt3)<br />     )<br />   )<br /> )<br /> <br /> <br /> (DEFUN BFZ (pzx / i  ll lll pzxa)<br /> ;(setq pzx '(1 2 3 4))<br /> (setq i 0) (setq ll '())<br /> (repeat (- (length pzx)1)<br />    (setq lll (list (nth i pzx) (nth (+ i 1) pzx)  ))<br />   (setq pzxa (cons lll pzxa))<br />   (setq i (1+ i))<br /> )<br /> pzxa<br /> )<br /> <br /> <br /> ;(setq en (car (entsel "\n请选择需要标注的线段")))<br /> <br /> <br /> <br /> <br /> (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))<br /> <br /> (mapcar  '(lambda (x) (spbz (polar (car x) (+(angle (car x) (cadr x))(* 0.5 pi)) 1.5)<br />   (car x) (cadr x))<br /> <br />       )   (bfz zbb))

树櫴希德

1. (defun mai_make_panel ( menulist / n num_nobut num_button nn nnn menuname val_lst add_dclrow tt order_lst in num_image)
   
2.   (defun add_dclrow ( dstr / ) (if dstr (setq val_lst (cons dstr val_lst))))
   
3.   (setq menuname (strcat (vl-filename-mktemp) "temp_pannel.dcl"))
   
4.   (add_dclrow "curbutton:button{width=10;vertical_margin=none;vertical_margin=none;}")
   
5.   (add_dclrow "curimage:image{width=10;height=0.2;vertical_margin=none;vertical_margin=none;}")
   
6.   (add_dclrow "curpanel:dialog{label=\"天正插件T20命令面板\";alignment=centered;vertical_margin=none;horizontal_margin=none;")
   
7.   (add_dclrow ":row{")
   
8.   (setq len (apply 'max (mapcar 'length menulist))
   
9.         order_lst (apply 'append (mapcar 'cdr menulist))
   
10.         num_button 0
    
11.         num_nobut 0
    
12.         in 0
    
13.         num_image 0
    
14.   )
    
15.   (foreach nn menulist
    
16.         (setq in 0)
    
17.         (add_dclrow (strcat " : boxed_column{label=\"" (car nn) "\";vertical_margin=none; horizontal_margin=none;"))
    
18.         (foreach nnn (cdr nn)
    
19.            (setq num_button (1+ num_button)
    
20.                  in (1+ in)
    
21.                  num_image (1+ num_image)
    
22.                  tt (car nnn)
    
23.                  tt (if tt tt "")
    
24.            )
    
25.            (add_dclrow (strcat ":curbutton{label=\"" tt "\";key=\"but" (itoa num_button) "\";}"))
    
26.            (if (= 4 in)
    
27.                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";color=18;}"))
    
28.                       (setq in 0)
    
29.                )
    
30.            )
    
31.         )
    
32.         (repeat (- len (length nn))
    
33.            (setq num_nobut (1+ num_nobut)
    
34.                  in (1+ in)
    
35.                  num_image (1+ num_image)
    
36.            )
    
37.            (add_dclrow (strcat " : curbutton{key=\"butno" (itoa num_nobut) "\";color=-2;}"))
    
38.            (if (= 4 in)
    
39.                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";}"))
    
40.                       (setq in 0)
    
41.                )
    
42.            )
    
43.         )
    
44.         (add_dclrow "spacer;}")
    
45.   )
    
46.    (add_dclrow "}:button{label=\"关闭\";key=\"cancel\";is_cancel=true;width=10;fixed_width=true;alignment=centered;}}")
    
47.    (vl-file-delete menuname)
    
48.    (setq nn (open menuname "w"))
    
49.    (foreach n (reverse val_lst) (write-line n nn))
    
50.    (close nn)
    
51.    (setq nnn (load_dialog menuname))
    
52.    (if (not (new_dialog "curpanel" nnn)) (exit))
    
53.    (setq n 0)
    
54.    (repeat num_nobut (mode_tile (strcat "butno" (itoa num_nobut)) 1) (setq num_nobut (1- num_nobut)))
    
55.   (foreach nn menulist
    
56.         (foreach nnn (cdr nn)
    
57.            (setq n (1+ n)
    
58.                  tt (car nnn)
    
59.                  tt (if tt tt "")
    
60.            )
    
61.            (if (= tt "")
    
62.                (mode_tile (strcat "but" (itoa n)) 1)
    
63.                (action_tile (strcat "but" (itoa n)) (strcat "\(done_dialog " (itoa n) "\)"))
    
64.            )
    
65.         )
    
66.   )
    
67.    (setq nn (start_dialog))
    
68.    (unload_dialog nnn)
    
69.    (vl-file-delete menuname)
    
70.   (if (> nn 0)
    
71.        (progn (setq tt (cadr (nth (1- nn) order_lst)))
    
72.               (princ "\n")
    
73.               (if (= (eval (read (strcat "(type c:" tt ")"))) 'SUBR)
    
74.                   (eval (read (strcat "(c:" tt ")")))
    
75.                   (vl-cmdf tt)
    
76.               )
    
77.        )
    
78.    )
    
79. )
    
80. 
    
81. (defun c:t20 ()
    
82. 
    
83.   (mai_make_panel
    
84. (list
    
85. (list "天正插件命令"
    
86. (list "版本信息" "tbbxx")
    
87. (list "炸开实体" "texplode")
    
88. (list "批量转旧版本" "tbatsave")
    
89.       nil
    
90. (list "图形导出" "tsaves")
    
91.   (list "图纸保护" "tprotect")   
    
92.     )
    
93. 
    
94. 
    
95. ) )
    
96.   (princ)
    
97. )
    
98. (princ "\n天正插件命令t20")

(defun mai_make_panel ( menulist / n num_nobut num_button nn nnn menuname val_lst add_dclrow tt order_lst in num_image)<br />   (defun add_dclrow ( dstr / ) (if dstr (setq val_lst (cons dstr val_lst))))<br />   (setq menuname (strcat (vl-filename-mktemp) "temp_pannel.dcl"))<br />   (add_dclrow "curbutton:button{width=10;vertical_margin=none;vertical_margin=none;}")<br />   (add_dclrow "curimage:image{width=10;height=0.2;vertical_margin=none;vertical_margin=none;}")<br />   (add_dclrow "curpanel:dialog{label=\"天正插件T20命令面板\";alignment=centered;vertical_margin=none;horizontal_margin=none;")<br />   (add_dclrow ":row{")<br />   (setq len (apply 'max (mapcar 'length menulist))<br />         order_lst (apply 'append (mapcar 'cdr menulist))<br />         num_button 0<br />         num_nobut 0<br />         in 0<br />         num_image 0<br />   )<br />   (foreach nn menulist<br />         (setq in 0)<br />         (add_dclrow (strcat " : boxed_column{label=\"" (car nn) "\";vertical_margin=none; horizontal_margin=none;"))<br />         (foreach nnn (cdr nn)<br />            (setq num_button (1+ num_button)<br />                  in (1+ in)<br />                  num_image (1+ num_image)<br />                  tt (car nnn)<br />                  tt (if tt tt "")<br />            )<br />            (add_dclrow (strcat ":curbutton{label=\"" tt "\";key=\"but" (itoa num_button) "\";}"))<br />            (if (= 4 in)<br />                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";color=18;}"))<br />                       (setq in 0)<br />                )<br />            )<br />         )<br />         (repeat (- len (length nn))<br />            (setq num_nobut (1+ num_nobut)<br />                  in (1+ in)<br />                  num_image (1+ num_image)<br />            )<br />            (add_dclrow (strcat " : curbutton{key=\"butno" (itoa num_nobut) "\";color=-2;}"))<br />            (if (= 4 in)<br />                (progn (add_dclrow (strcat ":curimage{key=\"ima" (itoa num_image) "\";}"))<br />                       (setq in 0)<br />                )<br />            )<br />         )<br />         (add_dclrow "spacer;}")<br />   )<br />    (add_dclrow "}:button{label=\"关闭\";key=\"cancel\";is_cancel=true;width=10;fixed_width=true;alignment=centered;}}")<br />    (vl-file-delete menuname)<br />    (setq nn (open menuname "w"))<br />    (foreach n (reverse val_lst) (write-line n nn))<br />    (close nn)<br />    (setq nnn (load_dialog menuname))<br />    (if (not (new_dialog "curpanel" nnn)) (exit))<br />    (setq n 0)<br />    (repeat num_nobut (mode_tile (strcat "butno" (itoa num_nobut)) 1) (setq num_nobut (1- num_nobut)))<br />   (foreach nn menulist<br />         (foreach nnn (cdr nn)<br />            (setq n (1+ n)<br />                  tt (car nnn)<br />                  tt (if tt tt "")<br />            )<br />            (if (= tt "")<br />                (mode_tile (strcat "but" (itoa n)) 1)<br />                (action_tile (strcat "but" (itoa n)) (strcat "\(done_dialog " (itoa n) "\)"))<br />            )<br />         )<br />   )<br />    (setq nn (start_dialog))<br />    (unload_dialog nnn)<br />    (vl-file-delete menuname)<br />   (if (> nn 0)<br />        (progn (setq tt (cadr (nth (1- nn) order_lst)))<br />               (princ "\n")<br />               (if (= (eval (read (strcat "(type c:" tt ")"))) 'SUBR)<br />                   (eval (read (strcat "(c:" tt ")")))<br />                   (vl-cmdf tt)<br />               )<br />        )<br />    )<br /> )<br /> <br /> (defun c:t20 ()<br /> <br />   (mai_make_panel<br /> (list<br /> (list "天正插件命令"<br /> (list "版本信息" "tbbxx")<br /> (list "炸开实体" "texplode")<br /> (list "批量转旧版本" "tbatsave")<br />       nil<br /> (list "图形导出" "tsaves")<br />   (list "图纸保护" "tprotect")    <br />     )<br /> <br /> <br /> ) )<br />   (princ)<br /> )<br /> (princ "\n天正插件命令t20")

树櫴希德

1. (vl-load-com)
   
2. (vl-load-com)
   
3. (defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt);桩号查询
   
4. (prompt "2010-07-27 zo roo  CGGC 武赤公路")
   
5. (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
   
6. (setq old_lay (getvar "clayer"))
   
7. (if (=(tblobjname "LAYER" "桩号标注") nil)
   
8.     (progn
   
9.         (entmake (list
   
10.                     '(0 . "LAYER")
    
11.                     '(100 . "AcDbSymbolTableRecord")
    
12.                     '(100 . "AcDbLayerTableRecord")
    
13.                     '(6 . "CONTINUOUS")
    
14.                     '(62 . 3)
    
15.                     '(70 . 0)
    
16.                     (cons 2 "桩号标注")
    
17.                   )
    
18.         )
    
19.     )
    
20. )
    
21. (setvar "clayer" "桩号标注")
    
22. (setq en  (entsel "\n选择道路中心线: ")
    
23. a (getreal "\n请输入起点桩号:")
    
24. e   (car en)
    
25. pt  (cadr en)
    
26. )
    
27. (if (setq len 2.000) ;此处要加入非法输入的控制
    
28.       (progn
    
29. (setq OBJ (vlax-ename->vla-object (car en)))
    
30. )
    
31. )
    
32. (while (setq pt0 (getPoint "\n选择查询点："))
    
33. ;画曲线的垂线
    
34. (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
    
35.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
    
36.     ANG   (atan (/ (cadr LST) (car LST)))
    
37.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
    
38.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
    
39.      ;此处就是你画出来的是水平线的原因，变量换个方向即可
    
40.    )
    
41. (setq ang2 (angtos (angle pt1 pt2 )0 4) )
    
42.    (command "pline" pt0 perpt "")
    
43. ;计算桩号
    
44.   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
    
45.   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
    
46.   leng2   (- leng leng1)
    
47. )
    
48. ;计算桩号
    
49. (if (< leng1 0.0) (setq fh "-") (setq fh "+"))
    
50. (setq nn1 (fix (/ leng1 1000.0 )))
    
51. (setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
    
52.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
    
53.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
    
54.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
    
55.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3))))
    
56.    
    
57.   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
    
58. (setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))
    
59.   
    
60.   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
    
61.   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)
    
62.   
    
63.   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
    
64.   
    
65. (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
    
66. (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
    
67. (setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
    
68. (princ pxy)
    
69. )
    
70.   (princ)
    
71. )
    
72. 
    
73. 
    
74. ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  

(vl-load-com)<br /> (vl-load-com)<br /> (defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt);桩号查询<br /> (prompt "2010-07-27 zo roo  CGGC 武赤公路")<br /> (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")<br /> (setq old_lay (getvar "clayer"))<br /> (if (=(tblobjname "LAYER" "桩号标注") nil)<br />     (progn<br />         (entmake (list<br />                     '(0 . "LAYER")<br />                     '(100 . "AcDbSymbolTableRecord")<br />                     '(100 . "AcDbLayerTableRecord")<br />                     '(6 . "CONTINUOUS")<br />                     '(62 . 3)<br />                     '(70 . 0)<br />                     (cons 2 "桩号标注")<br />                   )<br />         )<br />     )<br /> )<br /> (setvar "clayer" "桩号标注")<br /> (setq en  (entsel "\n选择道路中心线: ")<br /> a (getreal "\n请输入起点桩号:")<br /> e   (car en)<br /> pt  (cadr en)<br /> )<br /> (if (setq len 2.000) ;此处要加入非法输入的控制<br />       (progn<br /> (setq OBJ (vlax-ename->vla-object (car en)))<br /> )<br /> )<br /> (while (setq pt0 (getPoint "\n选择查询点："))<br /> ;画曲线的垂线<br /> (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)<br />     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))<br />     ANG   (atan (/ (cadr LST) (car LST)))<br />     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)<br />     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)<br />      ;此处就是你画出来的是水平线的原因，变量换个方向即可<br />    )<br /> (setq ang2 (angtos (angle pt1 pt2 )0 4) ) <br />    (command "pline" pt0 perpt "")<br /> ;计算桩号<br />   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))<br />   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))<br />   leng2   (- leng leng1)<br /> )<br /> ;计算桩号<br /> (if (< leng1 0.0) (setq fh "-") (setq fh "+")) <br /> (setq nn1 (fix (/ leng1 1000.0 ))) <br /> (setq nn2 (abs(- leng1 (* 1000.0 nn1 )))) <br />      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" ))) <br />      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3)))) <br />      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3)))) <br />      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3)))) <br />    <br />   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))<br /> (setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))<br />   <br />   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67)))) <br />   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)<br />   <br />   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)<br />   <br /> (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值<br /> (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值<br /> (setq pxy (strcat str_1"中桩坐标：X="px",Y="py))<br /> (princ pxy)<br /> )<br />   (princ)<br /> )<br /> <br /> <br /> ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  

树櫴希德

标注多段线

1. (vl-load-com)
   
2. (vl-load-com)
   
3. (defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt zbb);桩号查询
   
4. (prompt "2010-07-27 zo roo  CGGC 武赤公路")
   
5. 
   
6. (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))
   
7.   
   
8. (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")
   
9. (setq old_lay (getvar "clayer"))
   
10. (if (=(tblobjname "LAYER" "桩号标注") nil)
    
11.     (progn
    
12.         (entmake (list
    
13.                     '(0 . "LAYER")
    
14.                     '(100 . "AcDbSymbolTableRecord")
    
15.                     '(100 . "AcDbLayerTableRecord")
    
16.                     '(6 . "CONTINUOUS")
    
17.                     '(62 . 3)
    
18.                     '(70 . 0)
    
19.                     (cons 2 "桩号标注")
    
20.                   )
    
21.         )
    
22.     )
    
23. )
    
24. (setvar "clayer" "桩号标注")
    
25. (setq en  (entsel "\n选择道路中心线: ")
    
26. a (getreal "\n请输入起点桩号:")
    
27. e   (car en)
    
28. pt  (cadr en)
    
29. )
    
30. (if (setq len 2.000) ;此处要加入非法输入的控制
    
31.       (progn
    
32. (setq OBJ (vlax-ename->vla-object (car en)))
    
33. )
    
34. )
    
35. ( foreach x zbb  ;while
    
36.   ;(setq pt0 (getPoint "\n选择查询点："))
    
37. ;画曲线的垂线
    
38.   (setq pt0 x)
    
39. (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)
    
40.     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))
    
41.     ANG   (atan (/ (cadr LST) (car LST)))
    
42.     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)
    
43.     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)
    
44.      ;此处就是你画出来的是水平线的原因，变量换个方向即可
    
45.    )
    
46. (setq ang2 (angtos (angle pt1 pt2 )0 4) )
    
47.    (command "pline" pt0 perpt "")
    
48. ;计算桩号
    
49.   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
    
50.   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))
    
51.   leng2   (- leng leng1)
    
52. )
    
53. ;计算桩号
    
54. (if (< leng1 0.0) (setq fh "-") (setq fh "+"))
    
55. (setq nn1 (fix (/ leng1 1000.0 )))
    
56. (setq nn2 (abs(- leng1 (* 1000.0 nn1 ))))
    
57.      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" )))
    
58.      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3))))
    
59.      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3))))
    
60.      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3))))
    
61.    
    
62.   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))
    
63. (setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))
    
64.   
    
65.   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67))))
    
66.   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)
    
67.   
    
68.   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)
    
69.   
    
70. (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值
    
71. (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值
    
72. (setq pxy (strcat str_1"中桩坐标：X="px",Y="py))
    
73. (princ pxy)
    
74. )
    
75.   (princ)
    
76. )
    
77. 
    
78. 
    
79. ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  

(vl-load-com)<br /> (vl-load-com)<br /> (defun c:zhcx (/ en old_lay a e perpt pt0 obj len ang leng leng1 leng2 pt1 pt2 str_1 str_2 px py pxy nn1 nn2 pt zbb);桩号查询<br /> (prompt "2010-07-27 zo roo  CGGC 武赤公路")<br /> <br /> (setq zbb(mapcar  '(lambda (x) (CDR X) )  (vl-remove-if-not '(LAMBDA (X) (=(CAR X)10))   (CDR(entget(car(entsel"\n请选择需要标注的线段"))))) ))<br />   <br /> (prompt "*查询线路任意点桩号* << C:zhcx>> *计算中桩坐标*")<br /> (setq old_lay (getvar "clayer"))<br /> (if (=(tblobjname "LAYER" "桩号标注") nil)<br />     (progn<br />         (entmake (list<br />                     '(0 . "LAYER")<br />                     '(100 . "AcDbSymbolTableRecord")<br />                     '(100 . "AcDbLayerTableRecord")<br />                     '(6 . "CONTINUOUS")<br />                     '(62 . 3)<br />                     '(70 . 0)<br />                     (cons 2 "桩号标注")<br />                   )<br />         )<br />     )<br /> )<br /> (setvar "clayer" "桩号标注")<br /> (setq en  (entsel "\n选择道路中心线: ")<br /> a (getreal "\n请输入起点桩号:")<br /> e   (car en)<br /> pt  (cadr en)<br /> )<br /> (if (setq len 2.000) ;此处要加入非法输入的控制<br />       (progn<br /> (setq OBJ (vlax-ename->vla-object (car en)))<br /> )<br /> )<br /> ( foreach x zbb  ;while<br />   ;(setq pt0 (getPoint "\n选择查询点："))<br /> ;画曲线的垂线<br />   (setq pt0 x)<br /> (setq Perpt (vlax-curve-getClosestPointTo OBJ pt0 T)<br />     LST   (vlax-curve-getfirstderiv OBJ (vlax-curve-getparamatpoint OBJ Perpt))<br />     ANG   (atan (/ (cadr LST) (car LST)))<br />     pt1   (polar Perpt (+ ANG (* 0.5 pi)) len)<br />     pt2   (polar Perpt (- ANG (* 0.5 pi)) len)<br />      ;此处就是你画出来的是水平线的原因，变量换个方向即可<br />    )<br /> (setq ang2 (angtos (angle pt1 pt2 )0 4) ) <br />    (command "pline" pt0 perpt "")<br /> ;计算桩号<br />   (setq leng (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))<br />   leng1 (+ a (vlax-curve-getDistAtPoint e Perpt))<br />   leng2   (- leng leng1)<br /> )<br /> ;计算桩号<br /> (if (< leng1 0.0) (setq fh "-") (setq fh "+")) <br /> (setq nn1 (fix (/ leng1 1000.0 ))) <br /> (setq nn2 (abs(- leng1 (* 1000.0 nn1 )))) <br />      (if  (= nn2 0.0) (setq str_1 (strcat fh "00" ))) <br />      (if  (and (> nn2 0) (< nn2 10.0)) (setq str_1 (strcat (strcat fh "00" ) (rtos nn2 2 3)))) <br />      (if  (and (> nn2 10.0) (< nn2 100.0)) (setq str_1 (strcat (strcat fh "0" ) (rtos nn2 2 3)))) <br />      (if  (>= nn2 100.0)  (setq str_1 (strcat fh (rtos nn2 2 3)))) <br />    <br />   (setq str_1 (strcat "K"(rtos nn1 2 0)"+" (rtos nn2 2 3) ))<br /> (setq str_2 (strcat "距离："(rtos (distance pt0 perpt) 2 3) ))<br />   <br />   (setq pt4 (polar pt1 (+ (* pi 0.45) ang) (* -2 (* 1.65406 0.67)))) <br />   (command "text" "j" "MC" pt0 "0.3" ang2 str_1)<br />   <br />   (command "text" "j" "MC" (polar pt0 (+ (* pi 2) ang) (* -0.5 (* 1.65406 0.67))) "0.3" ang2 str_2)<br />   <br /> (setq py (rtos (nth 0 pt0)));提取测量坐标系Y值<br /> (setq px (rtos (nth 1 pt0)));提取测量坐标洗X值<br /> (setq pxy (strcat str_1"中桩坐标：X="px",Y="py))<br /> (princ pxy)<br /> )<br />   (princ)<br /> )<br /> <br /> <br /> ;(vlax-curve-getClosestPointTo (vlax-ename->vla-object (car (entsel))) (getpoint) T)  

树櫴希德

1. (setq en   (car (entsel "\n拾取:"))
   
2.       txt  (getstring "\n后缀:")
   
3.       col  (acad_truecolordlg '(62 . 1))
   
4.       ent  (entget en)
   
5.       txt1 (cdr (assoc 1 ent))
   
6.       txt1 (if (= "" txt1)
   
7.        "<>"
   
8.        txt1
   
9.      )
   
10.       txt  (strcat txt1 "{\\C" (itoa (cdar col)) ";(" txt ")}")
    
11.       ent  (subst (cons 1 txt) (assoc 1 ent) ent)
    
12. )
    
13. (entmod ent)

(setq en   (car (entsel "\n拾取:"))<br />       txt  (getstring "\n后缀:")<br />       col  (acad_truecolordlg '(62 . 1))<br />       ent  (entget en)<br />       txt1 (cdr (assoc 1 ent))<br />       txt1 (if (= "" txt1)<br />        "<>"<br />        txt1<br />      )<br />       txt  (strcat txt1 "{\\C" (itoa (cdar col)) ";(" txt ")}")<br />       ent  (subst (cons 1 txt) (assoc 1 ent) ent)<br /> )<br /> (entmod ent)

标注文字加后缀

shutiao

谢谢分享