椭圆中心标记

自贡黄明儒

1. ;;椭圆中心标记
   
2. ;;用highflybir的程序改造一下
   
3. (defun HH:ELLIPSEMark (ent / DXF MAJ P1 P10 P2 P3 P4 PTB PTD SS)
   
4.   (setq dxf (entget ent))
   
5.   (setq p10 (cdr (assoc 10 dxf)))
   
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.            (> (sslength ss) 1)
    
16.       )
    
17.     nil
    
18.     (progn
    
19.       (setq maj (cdr (assoc 11 dxf)))
    
20.       (setq ptb (vlax-curve-getPointAtParam ent (* pi 0.5)))
    
21.       (setq ptd (vlax-curve-getPointAtParam ent (* pi 1.5)))
    
22.       (setq p1 (mapcar '- ptd maj))
    
23.       (setq p2 (mapcar '+ ptd maj))
    
24.       (setq p3 (mapcar '+ ptb maj))
    
25.       (setq p4 (mapcar '- ptb maj))
    
26.       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p3)))
    
27.       (entmake (list (cons 0 "LINE") (cons 10 p2) (cons 11 p4)))
    
28.     )
    
29.   )
    
30. )
    
31. (defun C:W5 (/ EN)
    
32.   (setq ent (car (entsel)))
    
33.   (HH:ELLIPSEMark ent)
    
34.   (princ)
    
35. )

;;椭圆中心标记<br /> ;;用highflybir的程序改造一下<br /> (defun HH:ELLIPSEMark (ent / DXF MAJ P1 P10 P2 P3 P4 PTB PTD SS)<br />   (setq dxf (entget ent))<br />   (setq p10 (cdr (assoc 10 dxf)))<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 />            (> (sslength ss) 1)<br />       )<br />     nil<br />     (progn<br />       (setq maj (cdr (assoc 11 dxf)))<br />       (setq ptb (vlax-curve-getPointAtParam ent (* pi 0.5)))<br />       (setq ptd (vlax-curve-getPointAtParam ent (* pi 1.5)))<br />       (setq p1 (mapcar '- ptd maj))<br />       (setq p2 (mapcar '+ ptd maj))<br />       (setq p3 (mapcar '+ ptb maj))<br />       (setq p4 (mapcar '- ptb maj))<br />       (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p3)))<br />       (entmake (list (cons 0 "LINE") (cons 10 p2) (cons 11 p4)))<br />     )<br />   )<br /> )<br /> (defun C:W5 (/ EN)<br />   (setq ent (car (entsel)))<br />   (HH:ELLIPSEMark ent)<br />   (princ)<br /> )