xyp1964 发表于 2016-1-7 12:59:03

【e派】多段线弧心列表

;; tt(多段线圆弧圆心点集)
;; 方法1
;; 复制多段线，炸开过滤ARC，取圆心组表ptn，删除新实体，返回ptn
;; 优点：适于polyline和lwpolyline实体
;; 问题：伪源码太多，程序啰嗦
(defun xyp-PlineCerter (s1 / s0 s2 ss ptn)
(setq s0 (entlast)
        s2 (xyp-copy s1)
)
(xyp-explodeqf s2)
(setq ss (xyp-SSelEntnext s0)
        ptn (vl-remove-if-not '(lambda (x) (xyp-etype x "arc"))(xyp-Ss2List ss))
        ptn (mapcar '(lambda (x) (xyp-DXF 10 x)) ptn)
)
(xyp-erase ss)
ptn
)

;; 方法2
;; 直接过滤有凸点的点，利用osnap函数直接取圆心坐标
;; xyp-LwpCerter 多段线圆弧圆心点集 (xyp-LwpCerter ename)
;; 优点：代码精简
;; 问题：只适于lwpolyline实体
(defun xyp-LwpCerter (s1 / lst a b ptn)
(setq lst (vl-remove-if-not '(lambda (x) (member (car x) '(10 42)))(entget s1)))
(while (and (setq a (car lst)) (setq b (cadr lst)))
    (setq lst (cddr lst))
    (if        (/= (cdr b) 0)(setq ptn (cons (osnap (cdr a) "cen") ptn)))
)
(reverse ptn)
)

(defun c:tt ()
(if (and (setq s1 (car (entsel "\n选择多段线: ")))
           (setq ptn (xyp-LwpCerter s1))
      )
    (progn
      (xyp-Pline ptn nil)
      (mapcar '(lambda (x) (xyp-Cross x 10 0)) ptn)
    )
)
(princ)
)

zzyong00 发表于 2016-1-7 14:00:14

直接计算即可，我只有vb代码
http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=111783&pid=656515&fromuid=332660

ymcui 发表于 2016-1-7 14:10:36

好东西,谢谢版主分享。

434939575 发表于 2016-1-7 20:07:25

收藏下。感谢分享！

buddhism8 发表于 2019-2-26 17:53:34

院长威武
页: [1]
查看完整版本: 【e派】多段线弧心列表