求高手帮实现一简单功能

ifeelhard

画线标注板标高， 并使标高尺寸与直线平行。如图：

edata

1. ;;画线标高绘制主程序
   
2. ;;code by edta 2014-7-28 @mjtd.com
   
3. ;;命令bg2
   
4. (defun c:bg2(/ p1 p2 sk_level_s ang p3)
   
5.   (vl-load-com)
   
6.   (vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
   
7.   (setq *error*_Old *error*)                ;保存出错处理函数
   
8.   (setq *error* *error*_New)  
   
9.   (or sk_scale (setq sk_scale(cond((getint (strcat "\n输入标高比例<100>: ")))(100))))
   
10.   (or sk_level (setq sk_level 0.000))
    
11.   (setq bak_dimzin(getvar 'dimzin))
    
12.   (setvar 'dimzin 0)
    
13.   
    
14.   (if(and(setq sk_level(cond((getreal (strcat "\n输入标高值<"(rtos sk_level 2 3)">:")))(sk_level)))
    
15.          (list t (initget "s _s"))
    
16.          (setq p1(getpoint (strcat "\n指定第一点/(S)标高比例<" (itoa sk_scale) ">:")))
    
17.          (if (= p1 "s")
    
18.            (progn
    
19.              (setq sk_scale(cond((getint (strcat "\n输入标高比例<"(itoa sk_scale)">: ")))(sk_scale)))
    
20.              (setq p1(getpoint (strcat "\n指定第一点,当前标高比例<"(itoa sk_scale)">: "))))
    
21.            t
    
22.            )
    
23.          (setq p2(getpoint p1 "\n指定第二点:"))
    
24.          )
    
25.     (progn
    
26.       (if  (equal sk_level 0.000)
    
27.         (setq sk_level_s "%%P0.000")
    
28.         (setq sk_level_s (rtos sk_level 2 3))
    
29.         )
    
30.       (setq ang(angle p1 p2))
    
31.       (if (and (>= ang (* pi 0.5))(<= ang (* pi 1.5)))
    
32.         (setq p3 p1 p1 p2 p2 p3))            
    
33.       (sk_mk_level p1 p2 sk_level_s sk_scale)
    
34.       (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))      
    
35.       )
    
36.     )
    
37.   (and bak_dimzin(setvar 'dimzin bak_dimzin))
    
38.   (and *error*_Old(setq *error* *error*_Old))
    
39.   (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
    
40.   (princ)
    
41.   )
    
42. ;;标高生成函数
    
43. (defun sk_mk_level(p1 p2 sk_level sk_scale / ang lst mpt mpt1 p4 pt pt1 pt3 pt4 pt5 pt6)
    
44.   (setq mpt(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2)
    
45.         ang(angle p1 p2)
    
46.         mpt1(polar mpt (+ ang (* 0.5 pi)) (* 3 sk_scale))
    
47.         pt1(polar mpt1 ang (* 3 sk_scale))
    
48.         pt3(polar mpt1 ang (* -3 sk_scale))
    
49.         pt4(polar mpt1 ang (* 15 sk_scale))
    
50.         pt5(polar mpt1 ang (* 9 sk_scale))       
    
51.         lst (list pt1 mpt pt3 pt4)
    
52.         )
    
53.   (entmake (append
    
54.              (list '(0 . "LWPOLYLINE")
    
55.                    '(100 . "AcDbEntity")
    
56.                    '(100 . "AcDbPolyline")
    
57.                    (cons 90 (length lst)))
    
58.              (mapcar '(lambda (pt)(cons 10 pt)) lst ))
    
59.            )
    
60.   (entmake (list '(0 . "TEXT")
    
61.                  (cons 1 sk_level)
    
62.                  (cons 73 1)
    
63.                  (cons 72 1)
    
64.                  (cons 10 pt4)
    
65.                  (cons 11 pt5)
    
66.                  (cons 40 (* sk_scale 2.5))
    
67.                  (cons 50 ang))
    
68.            )
    
69.   )
    
70. ;;出错处理函数
    
71. (defun *error*_New (msg)  
    
72.   (and *error*_Old(setq *error* *error*_Old))
    
73.   (and bak_dimzin(setvar 'dimzin bak_dimzin))
    
74.   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    
75.     (if        (= (getvar "LOCALE") "CHS")
    
76.       (princ "\n用户按了<Esc>强制退出")
    
77.       (princ "\nYou cancelled The operation!")
    
78.     )
    
79.     (princ (strcat "\n" msg))
    
80.   )
    
81.   (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
    
82.   (princ)
    
83. )
    
84. (vl-load-com)
    
85. (prompt "\n画线标高 命令bg2")
    
86. (princ)

;;画线标高绘制主程序<br /> ;;code by edta 2014-7-28 @mjtd.com<br /> ;;命令bg2<br /> (defun c:bg2(/ p1 p2 sk_level_s ang p3)<br />   (vl-load-com)<br />   (vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (setq *error*_Old *error*)                ;保存出错处理函数<br />   (setq *error* *error*_New)  <br />   (or sk_scale (setq sk_scale(cond((getint (strcat "\n输入标高比例<100>: ")))(100))))<br />   (or sk_level (setq sk_level 0.000))<br />   (setq bak_dimzin(getvar 'dimzin))<br />   (setvar 'dimzin 0)<br />   <br />   (if(and(setq sk_level(cond((getreal (strcat "\n输入标高值<"(rtos sk_level 2 3)">:")))(sk_level)))<br />          (list t (initget "s _s"))<br />          (setq p1(getpoint (strcat "\n指定第一点/(S)标高比例<" (itoa sk_scale) ">:")))<br />          (if (= p1 "s")<br />            (progn<br />              (setq sk_scale(cond((getint (strcat "\n输入标高比例<"(itoa sk_scale)">: ")))(sk_scale)))<br />              (setq p1(getpoint (strcat "\n指定第一点,当前标高比例<"(itoa sk_scale)">: "))))<br />            t<br />            )<br />          (setq p2(getpoint p1 "\n指定第二点:"))<br />          )<br />     (progn<br />       (if  (equal sk_level 0.000)<br />         (setq sk_level_s "%%P0.000")<br />         (setq sk_level_s (rtos sk_level 2 3))<br />         )<br />       (setq ang(angle p1 p2))<br />       (if (and (>= ang (* pi 0.5))(<= ang (* pi 1.5)))<br />         (setq p3 p1 p1 p2 p2 p3))            <br />       (sk_mk_level p1 p2 sk_level_s sk_scale)<br />       (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))      <br />       )<br />     )<br />   (and bak_dimzin(setvar 'dimzin bak_dimzin))<br />   (and *error*_Old(setq *error* *error*_Old))<br />   (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (princ)<br />   )<br /> ;;标高生成函数<br /> (defun sk_mk_level(p1 p2 sk_level sk_scale / ang lst mpt mpt1 p4 pt pt1 pt3 pt4 pt5 pt6)<br />   (setq mpt(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2)<br />         ang(angle p1 p2)<br />         mpt1(polar mpt (+ ang (* 0.5 pi)) (* 3 sk_scale))<br />         pt1(polar mpt1 ang (* 3 sk_scale))<br />         pt3(polar mpt1 ang (* -3 sk_scale))<br />         pt4(polar mpt1 ang (* 15 sk_scale))<br />         pt5(polar mpt1 ang (* 9 sk_scale))        <br />         lst (list pt1 mpt pt3 pt4)<br />         )<br />   (entmake (append<br />              (list '(0 . "LWPOLYLINE")<br />                    '(100 . "AcDbEntity")<br />                    '(100 . "AcDbPolyline")<br />                    (cons 90 (length lst)))<br />              (mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />            )<br />   (entmake (list '(0 . "TEXT")<br />                  (cons 1 sk_level)<br />                  (cons 73 1)<br />                  (cons 72 1)<br />                  (cons 10 pt4)<br />                  (cons 11 pt5)<br />                  (cons 40 (* sk_scale 2.5))<br />                  (cons 50 ang))<br />            )<br />   )<br /> ;;出错处理函数<br /> (defun *error*_New (msg)  <br />   (and *error*_Old(setq *error* *error*_Old))<br />   (and bak_dimzin(setvar 'dimzin bak_dimzin))<br />   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")<br />     (if        (= (getvar "LOCALE") "CHS")<br />       (princ "\n用户按了<Esc>强制退出")<br />       (princ "\nYou cancelled The operation!")<br />     )<br />     (princ (strcat "\n" msg))<br />   )<br />   (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (princ)<br /> )<br /> (vl-load-com)<br /> (prompt "\n画线标高 命令bg2")<br /> (princ)

ifeelhard

十分感谢 收益良多

xyp1964