请各位老大，帮忙搞个画十字交叉线小程序。谢谢

lz123456

框选矩形和圆或者多线，能自动画出中心的十字交叉线。能区分那矩形的转角。能用于用户坐标系。那中心的十字交叉线长度能记忆，那长度能用户定义。最好的是能识别那不规则的围合多线的中心。不是那质心。网上找的那些不能用于用户坐标。

lz123456

网上找的那些不能识别那转角，有的不能一下框选，有的那长度不能自定义并记忆

lz123456

找到个合适的，只是不能框选。老大帮忙把那对圆，矩形改成可以框选就爽了。
(defun c:zx ()
  (vl-load-com)
  (setq ent0 (car (entsel "\n 请选择直线、圆、圆弧、椭圆和矩形:")))
  (setq ent1 (entget ent0))
  (setq name (cdr (assoc 0 ent1)))
  (setq os (getvar "osmode"))
  (setq cmd (getvar "CMDECHO"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 0)
;;;所选物体是直线
  (cond    ((= name "LINE")
     (setq ent2 (entget (car (entsel "\n 请选择另一条直线:"))))
     (setq point10 (cdr (assoc 10 ent1))
           point11 (cdr (assoc 11 ent1))
           point20 (cdr (assoc 10 ent2))
           point21 (cdr (assoc 11 ent2))
     ) ;_求两直线2个端点的坐标
     (setq ang1 (angle point10 point11)
           ang2 (angle point20 point21)
     )
     (if (or (equal (abs (- ang1 ang2)) pi 0.0001)
         (= (- ang1 ang2) 0)
         )
       (progn
         (setq obj (vlax-Ename->vla-object ent0))
         (setq p0 (vlax-curve-getClosestPointTo obj point20))
         (setq inter-point
            (mapcar '(lambda (a b) (/ (+ a b) 2))
                p0
                point20
            )
         )
         (print inter-point)
         (command "offset" "T" ent0 inter-point "")
       )
       (progn
         (setq inter-point (inters point10 point11 point20 point21 nil)) ;_求得两直线的交点
         (setq p0 (polar inter-point (angle inter-point point10) 10)
           p1 (polar inter-point (angle inter-point point20) 10)
         ) ;_求2个虚拟点

                    ;直线端点离交点最近判断
         (if (> (distance inter-point point10)
            (distance inter-point point11)
         )
           (setq p10 point11
             p11 point10
           )
           (setq p10 point10
             p11 point11
           )
         )
         (if (> (distance inter-point point20)
            (distance inter-point point21)
         )
           (setq p20 point21
             p21 point20
           )
           (setq p20 point20
             p21 point21
           )
         )
                    ;求角平分线上的虚拟点
         (setq inter-point0
            (mapcar '(lambda (a b) (/ (+ a b) 2)) p0 p1)
         )
         (setq p00 (inters p10 p20 inter-point inter-point0 nil)
           p01 (inters p11 p21 inter-point inter-point0 nil)
         )
         (command "LINE" p00 p01 "")
       )
     )
    )
;;;所选物体是圆
    ((or
       (= name "CIRCLE")
       (= name "ARC")
     )
     (setq point (cdr (assoc 10 ent1)))
     (setq r (cdr (assoc 40 ent1)))
     (setq l (+ r 300))
     (setq x (car point)
           y (cadr point)
     )
     (setq point10 (list (- x l) y))
     (setq point11 (list (+ x l) y))
     (setq point20 (list x (+ y l)))
     (setq point21 (list x (- y l)))


     (command "line" point10 point11 "")
     (command "line" point20 point21 "")


    )

;;;所选物体是圆弧
    ;;((= name "ARC")
    ;;    )

;;;所选物体是椭圆
    ((= name "ELLIPSE")
     (setq obj (vlax-Ename->Vla-Object ent0))
     (setq center-point (vlax-safearray->list
                  (vlax-variant-value (vla-get-Center obj))
                )
           StartPoint   (vlax-safearray->list
                  (vlax-variant-value (vla-get-StartPoint obj))
                )
           MajorRadius  (vla-get-MajorRadius obj)
           MinorRadius  (vla-get-MinorRadius obj)
     )
     (setq ang1 (angle center-point startpoint)
           ang2 (+ ang1 (* pi 0.5))
     )
     (setq point10 (polar center-point ang1 (+ MajorRadius 300))
           point11 (polar center-point
                  (+ ang1 pi)
                  (+ MajorRadius 300)
               )
           point20 (polar center-point ang2 (+ MinorRadius 300))
           point21 (polar center-point
                  (+ ang2 pi)
                  (+ MinorRadius 300)
               )
     )
     (command "LINE" point10 point11 "")
     (command "LINE" point20 point21 "")
    )

;;;所选物体是矩形   
    ((= name "LWPOLYLINE")
     (setq obj (vlax-Ename->Vla-Object ent0))
     (setq point (vlax-safearray->list
               (vlax-variant-value (vla-get-Coordinates obj))
             )
     )
     (if (= (length point) 8)
       (progn

         (setq p1 (list (nth 0 point) (nth 1 point))
           p2 (list (nth 2 point) (nth 3 point))
           p3 (list (nth 4 point) (nth 5 point))
           p4 (list (nth 6 point) (nth 7 point))
         )
         (setq center-point    (mapcar    '(lambda (a b) (/ (+ a b) 2))
                    p1
                    p3
                )
           ang1        (angle p1 p2)
           ang2        (angle p1 p4)
           d1        (distance p1 p2)
           d2        (distance p1 p4)
         )
         (setq point10 (polar center-point ang1 (+ (* d1 0.5) 300))
           point11 (polar center-point
                  (+ ang1 pi)
                  (+ (* d1 0.5) 300)
               )
           point20 (polar center-point ang2 (+ (* d2 0.5) 300))
           point21 (polar center-point
                  (+ ang2 pi)
                  (+ (* d2 0.5) 300)
               )
         )
         (command "LINE" point10 point11 "")
         (command "LINE" point20 point21 "")
       )
       (princ "\n所选物体不是矩形,请重新选择!")
     )
    )
    (T
     (princ
       "\n 所选物体不属于直线、圆、圆弧、椭圆和矩形之内,请重新选择!"
     )
    )
  )
  (setvar "OSMODE" os)
  (setvar "cmdecho" cmd)
  (princ)
)

Andyhon

2. 
   
3. (defun zx_1 ()
   
4.   (setq ent1 (entget ent0))
   
5.   (setq name (cdr (assoc 0 ent1)))
   
6.   (setq os (getvar "osmode"))
   
7.   (setq cmd (getvar "CMDECHO"))
   
8.   (setvar "cmdecho" 0)
   
9.   (setvar "OSMODE" 0)
   
10.   ;; 所选物体是直线
    
11.   (cond
    
12.     ((= name "LINE")
    
13.      (setq ent2 (entget (car (entsel "\n 请选择另一条直线:"))))
    
14.      (setq point10 (cdr (assoc 10 ent1))
    
15.            point11 (cdr (assoc 11 ent1))
    
16.            point20 (cdr (assoc 10 ent2))
    
17.            point21 (cdr (assoc 11 ent2))
    
18.      ) ;_求两直线2个端点的坐标
    
19.      (setq ang1        (angle point10 point11)
    
20.            ang2        (angle point20 point21)
    
21.      )
    
22.      (if (or (equal (abs (- ang1 ang2)) pi 0.0001)
    
23.              (= (- ang1 ang2) 0)
    
24.          )
    
25.        (progn
    
26.          (setq obj (vlax-Ename->vla-object ent0))
    
27.          (setq p0 (vlax-curve-getClosestPointTo obj point20))
    
28.          (setq inter-point
    
29.                 (mapcar        '(lambda (a b) (/ (+ a b) 2))
    
30.                         p0
    
31.                         point20
    
32.                 )
    
33.          )
    
34.          (print inter-point)
    
35.          (command "offset" "T" ent0 inter-point "")
    
36.        )
    
37.        (progn
    
38.          (setq inter-point (inters point10 point11 point20 point21 nil)) ;_求得两直线的交点
    
39.          (setq p0 (polar inter-point (angle inter-point point10) 10)
    
40.                p1 (polar inter-point (angle inter-point point20) 10)
    
41.          ) ;_求2个虚拟点
    
42. 
    
43.                                         ;直线端点离交点最近判断
    
44.          (if (>        (distance inter-point point10)
    
45.                 (distance inter-point point11)
    
46.              )
    
47.            (setq p10 point11
    
48.                  p11 point10
    
49.            )
    
50.            (setq p10 point10
    
51.                  p11 point11
    
52.            )
    
53.          )
    
54.          (if (>        (distance inter-point point20)
    
55.                 (distance inter-point point21)
    
56.              )
    
57.            (setq p20 point21
    
58.                  p21 point20
    
59.            )
    
60.            (setq p20 point20
    
61.                  p21 point21
    
62.            )
    
63.          )
    
64.                                         ;求角平分线上的虚拟点
    
65.          (setq inter-point0
    
66.                 (mapcar '(lambda (a b) (/ (+ a b) 2)) p0 p1)
    
67.          )
    
68.          (setq p00 (inters p10 p20 inter-point inter-point0 nil)
    
69.                p01 (inters p11 p21 inter-point inter-point0 nil)
    
70.          )
    
71.          (command "LINE" p00 p01 "")
    
72.        )
    
73.      )
    
74.     )
    
75.     ;; 所选物体是圆
    
76.     ((or
    
77.        (= name "CIRCLE")
    
78.        (= name "ARC")
    
79.      )
    
80.      (setq point (cdr (assoc 10 ent1)))
    
81.      (setq r (cdr (assoc 40 ent1)))
    
82.      (setq l (+ r 300))
    
83.      (setq x (car point)
    
84.            y (cadr point)
    
85.      )
    
86.      (setq point10 (list (- x l) y))
    
87.      (setq point11 (list (+ x l) y))
    
88.      (setq point20 (list x (+ y l)))
    
89.      (setq point21 (list x (- y l)))
    
90. 
    
91. 
    
92.      (command "line" point10 point11 "")
    
93.      (command "line" point20 point21 "")
    
94. 
    
95. 
    
96.     )
    
97. 
    
98.     ;; 所选物体是圆弧
    
99.     ;;((= name "ARC")
    
100.     ;;    )
     
101. 
     
102.     ;; 所选物体是椭圆
     
103.     ((= name "ELLIPSE")
     
104.      (setq obj (vlax-Ename->Vla-Object ent0))
     
105.      (setq center-point        (vlax-safearray->list
     
106.                           (vlax-variant-value (vla-get-Center obj))
     
107.                         )
     
108.            StartPoint        (vlax-safearray->list
     
109.                           (vlax-variant-value (vla-get-StartPoint obj))
     
110.                         )
     
111.            MajorRadius        (vla-get-MajorRadius obj)
     
112.            MinorRadius        (vla-get-MinorRadius obj)
     
113.      )
     
114.      (setq ang1        (angle center-point startpoint)
     
115.            ang2        (+ ang1 (* pi 0.5))
     
116.      )
     
117.      (setq point10 (polar center-point ang1 (+ MajorRadius 300))
     
118.            point11 (polar center-point
     
119.                           (+ ang1 pi)
     
120.                           (+ MajorRadius 300)
     
121.                    )
     
122.            point20 (polar center-point ang2 (+ MinorRadius 300))
     
123.            point21 (polar center-point
     
124.                           (+ ang2 pi)
     
125.                           (+ MinorRadius 300)
     
126.                    )
     
127.      )
     
128.      (command "LINE" point10 point11 "")
     
129.      (command "LINE" point20 point21 "")
     
130.     )
     
131. 
     
132.     ;; 所选物体是矩形   
     
133.     ((= name "LWPOLYLINE")
     
134.      (setq obj (vlax-Ename->Vla-Object ent0))
     
135.      (setq point (vlax-safearray->list
     
136.                    (vlax-variant-value (vla-get-Coordinates obj))
     
137.                  )
     
138.      )
     
139.      (if (= (length point) 8)
     
140.        (progn
     
141. 
     
142.          (setq p1 (list (nth 0 point) (nth 1 point))
     
143.                p2 (list (nth 2 point) (nth 3 point))
     
144.                p3 (list (nth 4 point) (nth 5 point))
     
145.                p4 (list (nth 6 point) (nth 7 point))
     
146.          )
     
147.          (setq center-point (mapcar '(lambda (a b) (/ (+ a b) 2))
     
148.                                     p1
     
149.                                     p3
     
150.                             )
     
151.                ang1            (angle p1 p2)
     
152.                ang2            (angle p1 p4)
     
153.                d1            (distance p1 p2)
     
154.                d2            (distance p1 p4)
     
155.          )
     
156.          (setq point10 (polar center-point ang1 (+ (* d1 0.5) 300))
     
157.                point11 (polar center-point
     
158.                               (+ ang1 pi)
     
159.                               (+ (* d1 0.5) 300)
     
160.                        )
     
161.                point20 (polar center-point ang2 (+ (* d2 0.5) 300))
     
162.                point21 (polar center-point
     
163.                               (+ ang2 pi)
     
164.                               (+ (* d2 0.5) 300)
     
165.                        )
     
166.          )
     
167.          (command "LINE" point10 point11 "")
     
168.          (command "LINE" point20 point21 "")
     
169.        )
     
170.        (princ "\n所选物体不是矩形,请重新选择!")
     
171.      )
     
172.     )
     
173.    )
     
174. )
     
175. 
     
176. (defun c:zx ()
     
177.   (vl-load-com)
     
178.   (princ "\n 请选择直线、圆、圆弧、椭圆和矩形:")
     
179.   (setq ss (ssget '((0 . "LINE,CIRCLE,ARC,ELLIPSE,LWPOLYLINE")))
     
180.          i  0
     
181.   )
     
182.   
     
183.   (while (setq ent0 (ssname ss i))
     
184.     (zx_1)
     
185.     (setq i (1+ i))
     
186.   )  
     
187.   
     
188.   (setvar "OSMODE" os)
     
189.   (setvar "cmdecho" cmd)
     
190.   (princ)
     
191. )
     

<br /> (defun zx_1 ()<br />   (setq ent1 (entget ent0))<br />   (setq name (cdr (assoc 0 ent1)))<br />   (setq os (getvar "osmode"))<br />   (setq cmd (getvar "CMDECHO"))<br />   (setvar "cmdecho" 0)<br />   (setvar "OSMODE" 0)<br />   ;; 所选物体是直线<br />   (cond<br />     ((= name "LINE")<br />      (setq ent2 (entget (car (entsel "\n 请选择另一条直线:"))))<br />      (setq point10 (cdr (assoc 10 ent1))<br />            point11 (cdr (assoc 11 ent1))<br />            point20 (cdr (assoc 10 ent2))<br />            point21 (cdr (assoc 11 ent2))<br />      ) ;_求两直线2个端点的坐标<br />      (setq ang1        (angle point10 point11)<br />            ang2        (angle point20 point21)<br />      )<br />      (if (or (equal (abs (- ang1 ang2)) pi 0.0001)<br />              (= (- ang1 ang2) 0)<br />          )<br />        (progn<br />          (setq obj (vlax-Ename->vla-object ent0))<br />          (setq p0 (vlax-curve-getClosestPointTo obj point20))<br />          (setq inter-point<br />                 (mapcar        '(lambda (a b) (/ (+ a b) 2))<br />                         p0<br />                         point20<br />                 )<br />          )<br />          (print inter-point)<br />          (command "offset" "T" ent0 inter-point "")<br />        )<br />        (progn<br />          (setq inter-point (inters point10 point11 point20 point21 nil)) ;_求得两直线的交点<br />          (setq p0 (polar inter-point (angle inter-point point10) 10)<br />                p1 (polar inter-point (angle inter-point point20) 10)<br />          ) ;_求2个虚拟点<br /> <br />                                         ;直线端点离交点最近判断<br />          (if (>        (distance inter-point point10)<br />                 (distance inter-point point11)<br />              )<br />            (setq p10 point11<br />                  p11 point10<br />            )<br />            (setq p10 point10<br />                  p11 point11<br />            )<br />          )<br />          (if (>        (distance inter-point point20)<br />                 (distance inter-point point21)<br />              )<br />            (setq p20 point21<br />                  p21 point20<br />            )<br />            (setq p20 point20<br />                  p21 point21<br />            )<br />          )<br />                                         ;求角平分线上的虚拟点<br />          (setq inter-point0<br />                 (mapcar '(lambda (a b) (/ (+ a b) 2)) p0 p1)<br />          )<br />          (setq p00 (inters p10 p20 inter-point inter-point0 nil)<br />                p01 (inters p11 p21 inter-point inter-point0 nil)<br />          )<br />          (command "LINE" p00 p01 "")<br />        )<br />      )<br />     )<br />     ;; 所选物体是圆<br />     ((or<br />        (= name "CIRCLE")<br />        (= name "ARC")<br />      )<br />      (setq point (cdr (assoc 10 ent1)))<br />      (setq r (cdr (assoc 40 ent1)))<br />      (setq l (+ r 300))<br />      (setq x (car point)<br />            y (cadr point)<br />      )<br />      (setq point10 (list (- x l) y))<br />      (setq point11 (list (+ x l) y))<br />      (setq point20 (list x (+ y l)))<br />      (setq point21 (list x (- y l)))<br /> <br /> <br />      (command "line" point10 point11 "")<br />      (command "line" point20 point21 "")<br /> <br /> <br />     )<br /> <br />     ;; 所选物体是圆弧<br />     ;;((= name "ARC")<br />     ;;    )<br /> <br />     ;; 所选物体是椭圆<br />     ((= name "ELLIPSE")<br />      (setq obj (vlax-Ename->Vla-Object ent0))<br />      (setq center-point        (vlax-safearray->list<br />                           (vlax-variant-value (vla-get-Center obj))<br />                         )<br />            StartPoint        (vlax-safearray->list<br />                           (vlax-variant-value (vla-get-StartPoint obj))<br />                         )<br />            MajorRadius        (vla-get-MajorRadius obj)<br />            MinorRadius        (vla-get-MinorRadius obj)<br />      )<br />      (setq ang1        (angle center-point startpoint)<br />            ang2        (+ ang1 (* pi 0.5))<br />      )<br />      (setq point10 (polar center-point ang1 (+ MajorRadius 300))<br />            point11 (polar center-point<br />                           (+ ang1 pi)<br />                           (+ MajorRadius 300)<br />                    )<br />            point20 (polar center-point ang2 (+ MinorRadius 300))<br />            point21 (polar center-point<br />                           (+ ang2 pi)<br />                           (+ MinorRadius 300)<br />                    )<br />      )<br />      (command "LINE" point10 point11 "")<br />      (command "LINE" point20 point21 "")<br />     )<br /> <br />     ;; 所选物体是矩形    <br />     ((= name "LWPOLYLINE")<br />      (setq obj (vlax-Ename->Vla-Object ent0))<br />      (setq point (vlax-safearray->list<br />                    (vlax-variant-value (vla-get-Coordinates obj))<br />                  )<br />      )<br />      (if (= (length point) 8)<br />        (progn<br /> <br />          (setq p1 (list (nth 0 point) (nth 1 point))<br />                p2 (list (nth 2 point) (nth 3 point))<br />                p3 (list (nth 4 point) (nth 5 point))<br />                p4 (list (nth 6 point) (nth 7 point))<br />          )<br />          (setq center-point (mapcar '(lambda (a b) (/ (+ a b) 2))<br />                                     p1<br />                                     p3<br />                             )<br />                ang1            (angle p1 p2)<br />                ang2            (angle p1 p4)<br />                d1            (distance p1 p2)<br />                d2            (distance p1 p4)<br />          )<br />          (setq point10 (polar center-point ang1 (+ (* d1 0.5) 300))<br />                point11 (polar center-point<br />                               (+ ang1 pi)<br />                               (+ (* d1 0.5) 300)<br />                        )<br />                point20 (polar center-point ang2 (+ (* d2 0.5) 300))<br />                point21 (polar center-point<br />                               (+ ang2 pi)<br />                               (+ (* d2 0.5) 300)<br />                        )<br />          )<br />          (command "LINE" point10 point11 "")<br />          (command "LINE" point20 point21 "")<br />        )<br />        (princ "\n所选物体不是矩形,请重新选择!")<br />      )<br />     )<br />    )<br /> )<br /> <br /> (defun c:zx ()<br />   (vl-load-com)<br />   (princ "\n 请选择直线、圆、圆弧、椭圆和矩形:")<br />   (setq ss (ssget '((0 . "LINE,CIRCLE,ARC,ELLIPSE,LWPOLYLINE")))<br />          i  0<br />   )<br />   <br />   (while (setq ent0 (ssname ss i))<br />     (zx_1)<br />     (setq i (1+ i))<br />   )  <br />   <br />   (setvar "OSMODE" os)<br />   (setvar "cmdecho" cmd)<br />   (princ)<br /> )<br />

lz123456

对直线结果不对，没关系。只是那多选画了那矩形的那交叉线后那捕捉没了。还有就那U不能一下U完。小问题没关系了。

xq4u

Andyhon 发表于 2011-7-15 12:38

开始没注意到，原来运行命令是：zx，很好用，可以框选。