关于多段线

pengfei2010 · 发表于 2013-11-21 19:47:13

不错的程序学习了

小生法号空明 · 发表于 2013-11-22 23:43:32

都是高手啊

llsheng_73 · 发表于 2013-11-23 01:16:52

老黄把这些也弄出来
a.线是否自相交
b.虚交点自动加点
第一个我弄了最终没弄出来
第二个我弄了但不适合二维多线段，郁闷死了

最后建议所有功能可以适合所有(cons 0 "*polyline")

自贡黄明儒 · 发表于 2013-11-23 09:05:37

本帖最后由自贡黄明儒于 2013-11-23 11:12 编辑

llsheng_73 发表于 2013-11-23 01:16
老黄把这些也弄出来
a.线是否自相交
b.虚交点自动加点

;;多段自相交(相交返回T),封闭也为自相交
;;(LPintersSelf (car (entsel)))
(defun LPintersSelf (en / ENT LEN1 LEN2 OBJ PTS)
  (setq ent (entget en))
  (setq pts (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent))
  (setq Len1 (- (length (mapcar 'cdr pts)) 2))
  (setq obj (vlax-ename->vla-object en))
  (setq pts (vla-intersectwith obj obj 0))
  (setq Len2 (vlax-safearray->list (vlax-variant-value pts)))
  (setq len2 (/ (length len2) 3))
  (not(equal len1 len2))
)

;;　(plinsp e) = 判断Pline自相交 ---by-- 狂刀 .2005.9
;; (plinsp (car(entsel)))
(defun plinsp (e / pts)
(setq o (vlax-ename->vla-object e))
(setq pts (vlax-invoke o 'intersectwith o 0))
(< (vlax-curve-getendparam e)
(+ 1 (vlax-get o 'closed) (/ (length pts) 3))
)
)

llsheng_73 · 发表于 2013-11-23 12:18:33

本帖最后由 llsheng_73 于 2013-11-23 13:27 编辑

自贡黄明儒发表于 2013-11-23 09:05
;;多段自相交(相交返回T),封闭也为自相交
;;(LPintersSelf (car (entsel)))
(defun LPintersSelf (en ...

虚交点就是当多线段A被延长到多线段B内部的时候，产生的那个交点P通常对于B来说就是一个虚交点，换句话说就是有公共边但没有公共点或者公共点个数不够
这个点有没有对B没有任何影响。但有这个点更容易保证两个相邻多线段不互相交叉或者产生细微裂缝

llsheng_73 · 发表于 2013-11-23 13:26:19

自贡黄明儒发表于 2013-11-23 09:05
;;多段自相交(相交返回T),封闭也为自相交
;;(LPintersSelf (car (entsel)))
(defun LPintersSelf (en ...

十分感谢老黄，不过测试了一下狂刀的，代码精简那是没法比，但是对于相交于一条边上的时候会判断为非自交，跟我最终失败的结果一个样子。

FANGZHENG158 · 发表于 2013-11-23 13:29:23

学习了。黄大侠，

守仁格竹GM · 发表于 2013-11-23 13:50:51

支持总结开源

aihuyujian · 发表于 2013-11-23 14:05:19

必须支持一个

自贡黄明儒 · 发表于 2013-11-23 14:12:25

本帖最后由自贡黄明儒于 2013-11-23 15:27 编辑

llsheng_73 发表于 2013-11-23 13:26
十分感谢老黄，不过测试了一下狂刀的，代码精简那是没法比，但是对于相交于一条边上的时候会判断为非自交 ...

你的意思狂刀的也有bug?想怎么做呢？是不是上面说的B

;;[功能] 多段线自相交
;; (plinsp (car(entsel)))
(defun plinsp (en / FLAG LAPT N O PTS PTS1 STPT)
;;52.1 [功能] 3D点->2D点 By Caoyin
(defun 3d->2d (3dpt)
(mapcar '+ 3dpt '(0. 0.))
)
;;52.4 [功能] 3D点列表->2D点列表
(defun 3dlist->2dlist (3dplist)
(mapcar '3d->2d 3dplist)
)
;;52.5 [功能] 对表分段
;;(xl_div lst nom)表分段. -> 返回分段的表. －－－－－－by 无痕.2004.1
;; lst ＝表，nom = 分段的子表元素个数(从1开始计).
;;示例 (xl_div '(1 2 3 4 5 6 7 8 9) 3) -> ((1 2 3) (4 5 6) (7 8 9))
(defun xl-div (lst x / lst2)
(foreach n lst
(if (and lst2 (/= x (length (car lst2))))
(setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
(setq lst2 (cons (list n) lst2))
)
)
(reverse lst2)
)
;;164.3 [功能] 多段线端点列表
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;;
;;(setq en (car (entsel)))
(setq o (vlax-ename->vla-object en))
(setq n (vlax-get o 'closed))
(cond ((equal n 0)
(setq laPt (vlax-curve-getEndPoint en))
(setq stPt (vlax-curve-getStartPoint en))
(setq pts (vlax-invoke o 'intersectwith o 0))
(setq pts (3dlist->2dlist (xl-div pts 3)))
(SETQ PTS1 (HH:PtLists EN))
(foreach i pts
(if (member i PTS1)
(setq flag T)
)
)
(or
flag
(/= (vlax-curve-getParamAtPoint en laPt)
(vlax-curve-getendparam en)
)
(/= (vlax-curve-getParamAtPoint en stPt)
(vlax-curve-getstartparam en)
)
(< (vlax-curve-getendparam en)
(+ 1 (/ (length pts) 3))
)
)
)
(T nil)
)
)

;;[功能] 多段线自相交 
;; (plinsp (car(entsel))) 
(defun plinsp (en / FLAG LAPT N O PTS PTS1 STPT) 
  ;;52.1 [功能] 3D点->2D点 By Caoyin 
  (defun 3d->2d (3dpt) 
    (mapcar '+ 3dpt '(0. 0.)) 
  ) 
  ;;52.4 [功能] 3D点列表->2D点列表 
  (defun 3dlist->2dlist (3dplist) 
    (mapcar '3d->2d 3dplist) 
  ) 
  ;;52.5 [功能] 对表分段 
  ;;(xl_div lst nom)表分段. -> 返回 分段的表.   －－－－－－by 无痕.2004.1 
  ;; lst ＝ 表，nom = 分段的子表元素个数(从1开始计). 
  ;;示例 (xl_div '(1 2 3 4 5 6 7 8 9) 3) -> ((1 2 3) (4 5 6) (7 8 9)) 
  (defun xl-div (lst x / lst2) 
    (foreach n lst 
      (if (and lst2 (/= x (length (car lst2)))) 
 (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2))) 
 (setq lst2 (cons (list n) lst2)) 
      ) 
    ) 
    (reverse lst2) 
  ) 
  ;;164.3 [功能] 多段线端点列表 
  ;;示例(HH:PtLists (car (entsel))) 
  (defun HH:PtLists (en) 
    (mapcar 'cdr 
     (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en)) 
    ) 
  ) 
  ;; 
  ;;(setq en (car (entsel))) 
  (setq o (vlax-ename->vla-object en)) 
  (setq n (vlax-get o 'closed)) 
  (cond ((equal n 0) 
  (setq laPt (vlax-curve-getEndPoint en)) 
  (setq stPt (vlax-curve-getStartPoint en)) 
  (setq pts (vlax-invoke o 'intersectwith o 0)) 
  (setq pts (3dlist->2dlist (xl-div pts 3))) 
  (SETQ PTS1 (HH:PtLists EN)) 
  (foreach i pts 
    (if (member i PTS1) 
      (setq flag T) 
    ) 
  ) 
  (or 
    flag 
    (/= (vlax-curve-getParamAtPoint en laPt) 
        (vlax-curve-getendparam en) 
    ) 
    (/= (vlax-curve-getParamAtPoint en stPt) 
        (vlax-curve-getstartparam en) 
    ) 
    (< (vlax-curve-getendparam en) 
       (+ 1 (/ (length pts) 3)) 
    )    
  ) 
 ) 
 (T nil) 
  ) 
)

账号		自动登录	找回密码
密码			注册

[讨论] 关于多段线

点评