【e派】多段线弧心列表

xyp1964

2. ;; tt(多段线圆弧圆心点集)
   
3. ;; 方法1
   
4. ;; 复制多段线，炸开过滤ARC，取圆心组表ptn，删除新实体，返回ptn
   
5. ;; 优点：适于polyline和lwpolyline实体
   
6. ;; 问题：伪源码太多，程序啰嗦
   
7. (defun xyp-PlineCerter (s1 / s0 s2 ss ptn)
   
8.   (setq s0 (entlast)
   
9.         s2 (xyp-copy s1)
   
10.   )
    
11.   (xyp-explodeqf s2)
    
12.   (setq ss (xyp-SSelEntnext s0)
    
13.         ptn (vl-remove-if-not '(lambda (x) (xyp-etype x "arc"))(xyp-Ss2List ss))
    
14.         ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) ptn)
    
15.   )
    
16.   (xyp-erase ss)
    
17.   ptn
    
18. )
    
19. 
    
20. ;; 方法2
    
21. ;; 直接过滤有凸点的点，利用osnap函数直接取圆心坐标
    
22. ;; xyp-LwpCerter 多段线圆弧圆心点集 (xyp-LwpCerter ename)
    
23. ;; 优点：代码精简
    
24. ;; 问题：只适于lwpolyline实体
    
25. (defun xyp-LwpCerter (s1 / lst a b ptn)
    
26.   (setq lst (vl-remove-if-not '(lambda (x) (member (car x) '(10 42)))(entget s1)))
    
27.   (while (and (setq a (car lst)) (setq b (cadr lst)))
    
28.     (setq lst (cddr lst))
    
29.     (if        (/= (cdr b) 0)(setq ptn (cons (osnap (cdr a) "cen") ptn)))
    
30.   )
    
31.   (reverse ptn)
    
32. )
    
33. 
    
34. (defun c:tt ()
    
35.   (if (and (setq s1 (car (entsel "\n选择多段线: ")))
    
36.            (setq ptn (xyp-LwpCerter s1))
    
37.       )
    
38.     (progn
    
39.       (xyp-Pline ptn nil)
    
40.       (mapcar '(lambda (x) (xyp-Cross x 10 0)) ptn)
    
41.     )
    
42.   )
    
43.   (princ)
    
44. )

;; tt(多段线圆弧圆心点集)<br /> ;; 方法1<br /> ;; 复制多段线，炸开过滤ARC，取圆心组表ptn，删除新实体，返回ptn<br /> ;; 优点：适于polyline和lwpolyline实体<br /> ;; 问题：伪源码太多，程序啰嗦<br /> (defun xyp-PlineCerter (s1 / s0 s2 ss ptn)<br />   (setq s0 (entlast)<br />         s2 (xyp-copy s1)<br />   )<br />   (xyp-explodeqf s2)<br />   (setq ss (xyp-SSelEntnext s0)<br />         ptn (vl-remove-if-not '(lambda (x) (xyp-etype x "arc"))(xyp-Ss2List ss))<br />         ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) ptn)<br />   )<br />   (xyp-erase ss)<br />   ptn<br /> )<br /> <br /> ;; 方法2<br /> ;; 直接过滤有凸点的点，利用osnap函数直接取圆心坐标<br /> ;; xyp-LwpCerter 多段线圆弧圆心点集 (xyp-LwpCerter ename)<br /> ;; 优点：代码精简<br /> ;; 问题：只适于lwpolyline实体<br /> (defun xyp-LwpCerter (s1 / lst a b ptn)<br />   (setq lst (vl-remove-if-not '(lambda (x) (member (car x) '(10 42)))(entget s1)))<br />   (while (and (setq a (car lst)) (setq b (cadr lst)))<br />     (setq lst (cddr lst))<br />     (if        (/= (cdr b) 0)(setq ptn (cons (osnap (cdr a) "cen") ptn)))<br />   )<br />   (reverse ptn)<br /> )<br /> <br /> (defun c:tt ()<br />   (if (and (setq s1 (car (entsel "\n选择多段线: ")))<br />            (setq ptn (xyp-LwpCerter s1))<br />       )<br />     (progn<br />       (xyp-Pline ptn nil)<br />       (mapcar '(lambda (x) (xyp-Cross x 10 0)) ptn)<br />     )<br />   )<br />   (princ)<br /> )

zzyong00

直接计算即可，我只有vb代码
http://bbs.mjtd.com/forum.php?mo ... &fromuid=332660

ymcui

好东西,谢谢版主分享。

434939575

收藏下。感谢分享！

buddhism8

院长威武