[其他]：关于Pline模拟Spline、ellipse

eachy

2. 
   
3. (defun SptoPl (e / sp ep spam epam pts)
   
4.   (setq        sp   (vlax-curve-getstartpoint e)
   
5.         ep   (vlax-curve-getendpoint e)
   
6.         spam (vlax-curve-getstartparam e)
   
7.         epam (vlax-curve-getendparam e)
   
8.   )
   
9.   (while (< spam epam)
   
10.     (setq p (vlax-curve-getpointatparam e spam))
    
11.     (setq pts (cons p pts))
    
12.     (setq spam (+ spam 10))
    
13.   )
    
14.   (if (not (equal (car pts) ep 0.000001))
    
15.     (setq pts (append  (list ep) pts))
    
16.   )
    
17.   (entmake
    
18.     (append
    
19.       (list '(0 . "LWPOLYLINE")
    
20.             '(100 . "AcDbEntity")
    
21.             '(100 . "AcDbPolyline")
    
22.             (cons 90 (length pts))
    
23.       )
    
24.       (mapcar '(lambda (x) (list 10 (car x) (cadr x)))
    
25.               pts
    
26.       )
    
27.     )
    
28.   )
    
29. )
    
30. (defun Eltopl (e / sp ep spam epam pts)
    
31.   (setq        sp   (vlax-curve-getstartpoint e)
    
32.         ep   (vlax-curve-getendpoint e)
    
33.         spam (vlax-curve-getstartparam e)
    
34.         epam (vlax-curve-getendparam e)
    
35.   )
    
36.   (while (< spam epam)
    
37.     (setq p (vlax-curve-getpointatparam e spam))
    
38.     (setq pts (cons p pts))
    
39.     (setq spam (+ spam (/ pi 180)))
    
40.   )
    
41.   (if (not (equal (car pts) ep 0.000001))
    
42.     (setq pts (append (list ep) pts))
    
43.   )
    
44.   (entmake
    
45.     (append
    
46.       (list '(0 . "LWPOLYLINE")
    
47.             '(100 . "AcDbEntity")
    
48.             '(100 . "AcDbPolyline")
    
49.             (cons 90 (length pts))
    
50.       )
    
51.       (mapcar '(lambda (x) (list 10 (car x) (cadr x)))
    
52.               pts
    
53.       )
    
54.     )
    
55.   )
    
56. )

<br /> (defun SptoPl (e / sp ep spam epam pts)<br />   (setq        sp   (vlax-curve-getstartpoint e)<br />         ep   (vlax-curve-getendpoint e)<br />         spam (vlax-curve-getstartparam e)<br />         epam (vlax-curve-getendparam e)<br />   )<br />   (while (< spam epam)<br />     (setq p (vlax-curve-getpointatparam e spam))<br />     (setq pts (cons p pts))<br />     (setq spam (+ spam 10))<br />   )<br />   (if (not (equal (car pts) ep 0.000001))<br />     (setq pts (append  (list ep) pts))<br />   )<br />   (entmake<br />     (append<br />       (list '(0 . "LWPOLYLINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbPolyline")<br />             (cons 90 (length pts))<br />       )<br />       (mapcar '(lambda (x) (list 10 (car x) (cadr x)))<br />               pts<br />       )<br />     )<br />   )<br /> )<br /> (defun Eltopl (e / sp ep spam epam pts)<br />   (setq        sp   (vlax-curve-getstartpoint e)<br />         ep   (vlax-curve-getendpoint e)<br />         spam (vlax-curve-getstartparam e)<br />         epam (vlax-curve-getendparam e)<br />   )<br />   (while (< spam epam)<br />     (setq p (vlax-curve-getpointatparam e spam))<br />     (setq pts (cons p pts))<br />     (setq spam (+ spam (/ pi 180)))<br />   )<br />   (if (not (equal (car pts) ep 0.000001))<br />     (setq pts (append (list ep) pts))<br />   )<br />   (entmake<br />     (append<br />       (list '(0 . "LWPOLYLINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbPolyline")<br />             (cons 90 (length pts))<br />       )<br />       (mapcar '(lambda (x) (list 10 (car x) (cadr x)))<br />               pts<br />       )<br />     )<br />   )<br /> )

aidraft

对椭圆会有：
命令: (SPTOPL (CAR (ENTSEL)))
选择对象: 在只有一个顶点的二维多段线 (0) 上增加一个顶点。
((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 1) (10
1025.87 1484.79))

xvjiex

感谢楼主分享！