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

/db_自贡黄明儒_

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

;;圆、弧时，如果中心点没有相互垂直的两条线，画十字中心线<br /> (defun HH:circleCross (en / ANG1 ANG2 E1EN E1ST E2EN E2ST EN1 EN2 ENT P10 PX1 PX2 PY1 PY2 R 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 />            (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 />     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 /> )

st788796

圆在屏幕内，圆心不一定在，所以ssget不一定对
吹毛求疵

/db_自贡黄明儒_

st788796 发表于 2013-11-18 12:49
圆在屏幕内，圆心不一定在，所以ssget不一定对
吹毛求疵

说得有道理
如果修改过滤条件，也只能满足水平或者垂直的情况，其它的可能难考虑到

st788796

/db_自贡黄明儒_ 发表于 2013-11-18 13:18
说得有道理
如果修改过滤条件，也只能满足水平或者垂直的情况，其它的可能难考虑到

这种应用可以把十字线记录到圆上，或者用组，或者用 ldata 等，这样选择后判断是不是存在且在原位置，不存在重画并更新，不在移回来