社区 › AutoLISP/Visual LISP 编程技术 › 多段线简化

aws 发表于 2024-10-14 12:26:55

多段线简化

;---去除多段线点集里面共线的点
(defun re-pts(en / pts pts1 pts2 pts3)
(setq pts(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x)10))(entget en))))
(if(vlax-curve-isClosed(vlax-ename->vla-object en))
    (progn
      (setq pts2(append(cdr pts)(list(car pts))))
      (setq pts3(append(cdr pts2)(list(car pts2))))
      (vl-remove nil(mapcar '(lambda(x1 x2 x3)(if(equal 0(chaji x1 x2 x3)0.01)nil x2))pts pts2 pts3))
    )
    (progn
      (setq pts1(reverse(cdr(cdr(reverse pts)))))
      (setq pts2(cdr(reverse(cdr(reverse pts)))))
      (setq pts3(cdr(cdr pts)))
      (append(list(car pts))(vl-remove nil(mapcar '(lambda(x1 x2 x3)(if(equal 0(chaji x1 x2 x3)0.01)nil x2))pts1 pts2 pts3))(list(last pts)))
    )
)
)
;---向量叉积，等于0代表共线
(defun chaji(p0 p1 p2)
(-
    (*(-(car p1)(car p0))(-(cadr p2)(cadr p0)))
    (*(-(car p2)(car p0))(-(cadr p1)(cadr p0)))
)
)


核心子函数如上，不支持含有圆弧的多段线。
如果加上圆弧，可能复杂一点，，，暂时没思路

kozmosovia 发表于 2024-10-24 10:58:36

放着OVerkill不用自己写代码？

飞的鱼儿 发表于 2024-10-14 16:18:49

这功能也不错的。

hubeiwdlue 发表于 2024-10-15 19:09:13

本帖最后由 hubeiwdlue 于 2024-10-15 19:50 编辑

谢谢分享，学习了。我换个思路写一个。
;---向量叉积，等于0代表共线
(defun chaji(p0 p1 p2)
(-
    (*(-(car p1)(car p0))(-(cadr p2)(cadr p0)))
    (*(-(car p2)(car p0))(-(cadr p1)(cadr p0)))
)
)
;去除一个线段中间共线节点
(defun rmp1(plst)
(while (and(> (length plst) 2) (equal 0 (chaji (car plst) (cadr plst) (caddr plst)) 0.001))
    (setq plst (cons (car plst) (cddr plst)))
)
plst
)
;院长的多段线函数
(defun xyp-Entmake-lwPolyline (ptlst Close-tnil / a s1)
(entmake (append (list '(0 . "LWPOLYLINE")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbPolyline")
                     (cons 90 (length ptlst))
                     (cons 70 (if Close-tnil 1 0))
                     (cons 38
                     (if (nth 2 (car ptlst))
                         (nth 2 (car ptlst))
                         0
                     )
                     )
                   )
             (mapcar '(lambda (a) (cons 10 a)) ptlst)
         )
)
(entlast)
)
;去除共线点
(defun c:tt(/ )
(setq en (car(entsel)))
(setq p70 (cdr(assoc 70 (entget en))))
(setq plst(mapcar 'cdr(vl-remove-if-not '(lambda(x)(=(car x)10))(entget en))))
(setq plst1 nil)
(while (> (length plst) 0)
    (setq plst (rmp1 plst))
    (setq plst1 (cons (car plst) plst1))
    (setq plst (cdr plst))
)
(setq plst1 (vl-remove nil (reverse plst1)))
(if (= p70 0)
    (xyp-Entmake-lwPolyline plst1 nil)
    (xyp-Entmake-lwPolyline plst1 t)
)
)

有区别吗 发表于 2024-10-16 15:32:19

我服了,正好今天碰上这个需求,还说没什么思路,上来看看,随手一点就有现成的了..
;P

guankuiwu 发表于 2024-10-16 16:28:44

圆弧还有有必要搞一搞的:handshake

Qwer1243 发表于 2024-10-24 09:02:17

感谢分享，学习一下

查看完整版本: 多段线简化