MoveStretchPoint应用之割齐标注

st788796

写的比较简单，对线性标注“长短腿”进行割齐，目的是加深对 Stretchpoint 在 标注 实体上的应用

1. (defun c:tt (/ ss e pl p1 p3 p4 an p0 e pts v1 v2)
   
2.   (if (and
   
3.         (setq e (car (xdrx_entsel "\n选择基准标注: " '((0 . "Dimension")))))
   
4.         (setq p (getpoint "\n割齐点: "))
   
5.         (setq ss (xdrx_ssget "\n选择标注: " '((0 . "Dimension"))))
   
6.       )
   
7.     (progn
   
8.       (ssadd e ss)
   
9.       (setq pl (xdrx_entity_getstretchpoint e)
   
10.             p3 (caddr pl)
    
11.             p4 (caddr pl)
    
12.             an (angle p3 p4)
    
13.             p0 (polar p an 100.)
    
14.       )
    
15.       (xdrx_setsstodb ss 0)
    
16.       (while (setq e (xdrx_getentdata 0))
    
17.         (setq pts (xdrx_entity_getstretchpoint e)
    
18.               v1 (mapcar
    
19.                    '-
    
20.                    (inters p p0 (car pts) (caddr pts) nil)
    
21.                    (car pts)
    
22.                  )
    
23.               v2 (mapcar
    
24.                    '-
    
25.                    (inters p p0 (cadr pts) (cadddr pts) nil)
    
26.                    (cadr pts)
    
27.                  )
    
28.         )
    
29.         (xdrx_entity_movestretchpoint e v1 0)
    
30.         (xdrx_entity_movestretchpoint e v2 1)
    
31.       )
    
32.     )
    
33.   )
    
34.   (princ)
    
35. )

(defun c:tt (/ ss e pl p1 p3 p4 an p0 e pts v1 v2)<br />   (if (and<br />         (setq e (car (xdrx_entsel "\n选择基准标注: " '((0 . "Dimension")))))<br />         (setq p (getpoint "\n割齐点: "))<br />         (setq ss (xdrx_ssget "\n选择标注: " '((0 . "Dimension"))))<br />       )<br />     (progn<br />       (ssadd e ss)<br />       (setq pl (xdrx_entity_getstretchpoint e)<br />             p3 (caddr pl)<br />             p4 (caddr pl)<br />             an (angle p3 p4)<br />             p0 (polar p an 100.)<br />       )<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (setq pts (xdrx_entity_getstretchpoint e)<br />               v1 (mapcar<br />                    '-<br />                    (inters p p0 (car pts) (caddr pts) nil)<br />                    (car pts)<br />                  )<br />               v2 (mapcar<br />                    '-<br />                    (inters p p0 (cadr pts) (cadddr pts) nil)<br />                    (cadr pts)<br />                  )<br />         )<br />         (xdrx_entity_movestretchpoint e v1 0)<br />         (xdrx_entity_movestretchpoint e v2 1)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

XDSoft

帮修改下代码，只适合线性转角标注。

1. (defun c:tt (/ ss e pl p1 p3 p4 an p0 e pts v1 v2)
   
2.   (if (and
   
3.         (setq e (car (xdrx_entsel "\n选择基准标注: " '((0 . "Dimension")))))
   
4.         (= 0 (logand (xdrx_getentdxf 70) 1)) ;;转角线性标注
   
5.         (setq p (getpoint "\n割齐点: "))
   
6.         (setq ss (xdrx_ssget "\n选择标注: " '((0 . "Dimension"))))
   
7.       )
   
8.     (progn
   
9.       (ssadd e ss)
   
10.       (setq pl (xdrx_entity_getstretchpoint e)
    
11.             p3 (caddr pl)
    
12.             p4 (caddr pl)
    
13.             an (angle p3 p4)
    
14.             p0 (polar p an 100.)
    
15.       )
    
16.       (xdrx_setsstodb ss 0)
    
17.       (while (and
    
18.                 (setq e (xdrx_getentdata 0))
    
19.                 (= 0 (logand (xdrx_getentdxf 70) 1))  ;;线性转角标注
    
20.              )
    
21.         (setq pts (xdrx_entity_getstretchpoint e)
    
22.               v1 (mapcar
    
23.                    '-
    
24.                    (inters p p0 (car pts) (caddr pts) nil)
    
25.                    (car pts)
    
26.                  )
    
27.               v2 (mapcar
    
28.                    '-
    
29.                    (inters p p0 (cadr pts) (cadddr pts) nil)
    
30.                    (cadr pts)
    
31.                  )
    
32.         )
    
33.         (xdrx_entity_movestretchpoint e v1 0)
    
34.         (xdrx_entity_movestretchpoint e v2 1)
    
35.       )
    
36.     )
    
37.   )
    
38.   (princ)
    
39. )
    

(defun c:tt (/ ss e pl p1 p3 p4 an p0 e pts v1 v2)<br />   (if (and<br />         (setq e (car (xdrx_entsel "\n选择基准标注: " '((0 . "Dimension")))))<br />         (= 0 (logand (xdrx_getentdxf 70) 1)) ;;转角线性标注<br />         (setq p (getpoint "\n割齐点: "))<br />         (setq ss (xdrx_ssget "\n选择标注: " '((0 . "Dimension"))))<br />       )<br />     (progn<br />       (ssadd e ss)<br />       (setq pl (xdrx_entity_getstretchpoint e)<br />             p3 (caddr pl)<br />             p4 (caddr pl)<br />             an (angle p3 p4)<br />             p0 (polar p an 100.)<br />       )<br />       (xdrx_setsstodb ss 0)<br />       (while (and <br />                 (setq e (xdrx_getentdata 0))<br />                 (= 0 (logand (xdrx_getentdxf 70) 1))  ;;线性转角标注<br />              )<br />         (setq pts (xdrx_entity_getstretchpoint e)<br />               v1 (mapcar<br />                    '-<br />                    (inters p p0 (car pts) (caddr pts) nil)<br />                    (car pts)<br />                  )<br />               v2 (mapcar<br />                    '-<br />                    (inters p p0 (cadr pts) (cadddr pts) nil)<br />                    (cadr pts)<br />                  )<br />         )<br />         (xdrx_entity_movestretchpoint e v1 0)<br />         (xdrx_entity_movestretchpoint e v2 1)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

lgttblue

强悍啊，努力学习