圆、弧时，如果中心点没有相互垂直的两条线，画十字中心线

自贡黄明儒

1. ;;圆、弧时，如果中心点没有相互垂直的两条线，画十字中心线
   
2. (defun HH:circleCross (en / ANG1 ANG2 E1EN E1ST        E2EN E2ST EN1 EN2 ENT P10 PX1 PX2 PY1 PY2 R
   
3.                        SS)
   
4.   (setq ent (entget en))
   
5.   (setq p10 (cdr (assoc 10 ent)))
   
6.   (setq r (* (cdr (assoc 40 ent)) 1.25))
   
7.   (if (and (setq ss (ssget "_C"
   
8.                            p10
   
9.                            p10
   
10.                            (list '(-4 . "<or")          '(0 . "LINE")           '(-4 . "<and")
    
11.                                  '(0 . "LWPOLYLINE")                   '(90 . 2)
    
12.                                  '(-4 . "and>")          '(-4 . "or>")
    
13.                                 )
    
14.                     )
    
15.            )
    
16.            (cond ((equal (sslength ss) 2)
    
17.                   (setq en1 (ssname ss 0))
    
18.                   (setq en2 (ssname ss 1))
    
19.                   (setq e1st (vlax-curve-getStartPoint en1))
    
20.                   (setq e1en (vlax-curve-getendPoint en1))
    
21.                   (setq e2st (vlax-curve-getStartPoint en2))
    
22.                   (setq e2en (vlax-curve-getendPoint en2))
    
23.                   (setq ang1 (angle e1st e1en))
    
24.                   (setq ang2 (angle e2st e2en))
    
25.                   (equal (rem (- ang1 ang2) (/ pi 2)) 0)
    
26.                  )
    
27.                  ((> (sslength ss) 2) T)
    
28.                  (T nil)
    
29.            )
    
30.       )
    
31.     nil
    
32.     (progn
    
33.       (setq px1 (mapcar '- p10 (list r 0 0)))
    
34.       (setq px2 (mapcar '+ p10 (list r 0 0)))
    
35.       (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))
    
36.       (setq py1 (mapcar '- p10 (list 0 r 0)))
    
37.       (setq py2 (mapcar '+ p10 (list 0 r 0)))
    
38.       (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))
    
39.     )
    
40.   )
    
41. )
    
42. (defun C:W3 (/ EN)
    
43.   (setq en (car (entsel)))
    
44.   (HH:circleCross en)
    
45.   (princ)
    
46. )
    

;;圆、弧时，如果中心点没有相互垂直的两条线，画十字中心线<br /> (defun HH:circleCross (en / ANG1 ANG2 E1EN E1ST        E2EN E2ST EN1 EN2 ENT P10 PX1 PX2 PY1 PY2 R<br />                        SS)<br />   (setq ent (entget en))<br />   (setq p10 (cdr (assoc 10 ent)))<br />   (setq r (* (cdr (assoc 40 ent)) 1.25))<br />   (if (and (setq ss (ssget "_C"<br />                            p10<br />                            p10<br />                            (list '(-4 . "<or")          '(0 . "LINE")           '(-4 . "<and")<br />                                  '(0 . "LWPOLYLINE")                   '(90 . 2)<br />                                  '(-4 . "and>")          '(-4 . "or>")<br />                                 )<br />                     )<br />            )<br />            (cond ((equal (sslength ss) 2)<br />                   (setq en1 (ssname ss 0))<br />                   (setq en2 (ssname ss 1))<br />                   (setq e1st (vlax-curve-getStartPoint en1))<br />                   (setq e1en (vlax-curve-getendPoint en1))<br />                   (setq e2st (vlax-curve-getStartPoint en2))<br />                   (setq e2en (vlax-curve-getendPoint en2))<br />                   (setq ang1 (angle e1st e1en))<br />                   (setq ang2 (angle e2st e2en))<br />                   (equal (rem (- ang1 ang2) (/ pi 2)) 0)<br />                  )<br />                  ((> (sslength ss) 2) T)<br />                  (T nil)<br />            )<br />       )<br />     nil<br />     (progn<br />       (setq px1 (mapcar '- p10 (list r 0 0)))<br />       (setq px2 (mapcar '+ p10 (list r 0 0)))<br />       (entmake (list (cons 0 "LINE") (cons 10 px1) (cons 11 px2)))<br />       (setq py1 (mapcar '- p10 (list 0 r 0)))<br />       (setq py2 (mapcar '+ p10 (list 0 r 0)))<br />       (entmake (list (cons 0 "LINE") (cons 10 py1) (cons 11 py2)))<br />     )<br />   )<br /> )<br /> (defun C:W3 (/ EN)<br />   (setq en (car (entsel)))<br />   (HH:circleCross en)<br />   (princ)<br /> )<br />

w245272914

黄老师，这函数我给你挖出来，让你回忆下，哈哈。

可不可以圆与直线  弧与直线    他们的最近点两线链接并垂直啊。