返回多段线自交点

ayl1004 · 发表于 2013-6-7 22:39:31

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 ayl1004 于 2013-6-8 01:10 编辑

;;;把数组转换过来的表转成点表
(defun GetPts (Lst)
(if (caddr Lst)
(cons
(list (car Lst) (cadr Lst) (caddr Lst))
(GetPts (cdddr Lst))
)
)
)
;;;计算两个vla对象的交点
(defun intersectPts (vlaobj1 vlaobj2 / ptsVar ptsArray ptsList)
(setq ptsVar (vla-intersectwith vlaobj1 vlaobj2 acExtendNone)
ptsArray (vlax-variant-value ptsVar)
ptsList (vl-catch-all-apply 'vlax-safeArray->list (list ptsArray))
)
(if (vl-catch-all-error-p ptsList)
nil
(GetPts ptsList)
)
)
;;;移除多段线不是自交点的角点参量
;;;EndPrm 多段线终点参量
;;;Pline 多段线对象
(defun RemoveParam (EndPrm Pline / SomPrm)
(cond ((= EndPrm 0) nil)
((= (setq SomPrm (vlax-curve-GetParamAtPoint
Pline
(vlax-curve-GetPointAtParam Pline EndPrm)
)
)
EndPrm
)
(RemoveParam (1- EndPrm) Pline)
)
((/= SomPrm EndPrm)
(cons SomPrm (RemoveParam (1- EndPrm) Pline))
)
)
)
;;;多段线所有自交点
(defun GetAllSelfInters (Ename / VlaObj PrmLst)
(setq VlaObj (vlax-ename->vla-object Ename))
(setq
PrmLst (append
;;非角点自交
(vl-remove-if
(function (lambda (x) (= (fix x) x)))
(mapcar
(function
(lambda (x) (vlax-curve-GetParamAtPoint VlaObj x))
)
(intersectPts VlaObj VlaObj)
)
)
;;角点自交
(RemoveParam (vlax-curve-GetEndParam VlaObj) VlaObj)
)
)
;;所有自交点参量按从小到大排列，并转换成点
(mapcar (function (lambda (x) (vlax-curve-GetPointAtParam VlaObj x))
)
(vl-sort PrmLst '<)
)
)

;;;把数组转换过来的表转成点表 
(defun GetPts (Lst) 
  (if (caddr Lst) 
    (cons 
      (list (car Lst) (cadr Lst) (caddr Lst)) 
      (GetPts (cdddr Lst)) 
    ) 
  ) 
) 
;;;计算两个vla对象的交点 
(defun intersectPts (vlaobj1 vlaobj2 / ptsVar ptsArray ptsList) 
  (setq ptsVar  (vla-intersectwith vlaobj1 vlaobj2 acExtendNone) 
ptsArray (vlax-variant-value ptsVar) 
ptsList  (vl-catch-all-apply 'vlax-safeArray->list (list ptsArray)) 
  ) 
  (if (vl-catch-all-error-p ptsList) 
    nil 
    (GetPts ptsList) 
  ) 
) 
;;;移除多段线不是自交点的角点参量 
;;;EndPrm 多段线终点参量 
;;;Pline 多段线对象 
(defun RemoveParam (EndPrm Pline / SomPrm) 
  (cond ((= EndPrm 0) nil) 
((= (setq SomPrm (vlax-curve-GetParamAtPoint 
      Pline 
      (vlax-curve-GetPointAtParam Pline EndPrm) 
    ) 
     ) 
     EndPrm 
  ) 
  (RemoveParam (1- EndPrm) Pline) 
) 
((/= SomPrm EndPrm) 
  (cons SomPrm (RemoveParam (1- EndPrm) Pline)) 
) 
  ) 
) 
;;;多段线所有自交点 
(defun GetAllSelfInters (Ename / VlaObj PrmLst) 
  (setq VlaObj (vlax-ename->vla-object Ename)) 
  (setq 
    PrmLst (append 
      ;;非角点自交 
      (vl-remove-if 
        (function (lambda (x) (= (fix x) x))) 
        (mapcar 
   (function 
     (lambda (x) (vlax-curve-GetParamAtPoint VlaObj x)) 
   ) 
   (intersectPts VlaObj VlaObj) 
        ) 
      ) 
      ;;角点自交 
      (RemoveParam (vlax-curve-GetEndParam VlaObj) VlaObj) 
    ) 
  ) 
  ;;所有自交点参量按从小到大排列，并转换成点 
  (mapcar (function (lambda (x) (vlax-curve-GetPointAtParam VlaObj x)) 
   ) 
   (vl-sort PrmLst '<) 
  ) 
)

Free-Lancer · 发表于 2013-6-7 23:04:49

本帖最后由 Free-Lancer 于 2013-6-7 23:06 编辑

LZ这个帖子看起来太费劲了，发布有特殊的页面，把函数功能、参数意义、返回值、说明等等讲清楚，你再试试
另外，GetAllSelfInters 可以求得 Intersectwith 后和顶点数量比较，如果多了就是有自身交点，把那个多余的找出来即可

XDSoft · 发表于 2013-6-7 23:08:34

把函数整理下，能分出来的就分出来，发帖时候选第二个 “函数发布”，按提示发布就行了。

ayl1004 · 发表于 2013-6-8 01:04:24

Free-Lancer 发表于 2013-6-7 23:04
LZ这个帖子看起来太费劲了，发布有特殊的页面，把函数功能、参数意义、返回值、说明等等讲清楚，你再试试
...

你没考虑角点是自交点

Lispboy · 发表于 2013-6-8 01:33:34

ayl1004 发表于 2013-6-8 01:04
你没考虑角点是自交点

找到所有的交点，判断下点是否在顶点表里面不在的，就是外面的交点。

13808843088 · 发表于 2013-6-8 08:04:56

GetPts不用递归，写了一个啰嗦

(defun GetPts (lst / lst1 lst2)
(repeat (/ (length lst) 3)
(setq lst1 nil)
(repeat 3
(setq lst1 (cons (car lst) lst1)
lst (cdr lst)
)
)
(setq lst2 (cons (reverse lst1) lst2))
)
(reverse lst2)
)

Free-Lancer · 发表于 2013-6-9 05:35:14

可以发布一个判断多段线是否自交函数来自: Android客户端

q3_2006 · 发表于 2013-6-18 07:23:26

6楼精简呀，高！

llsheng_73 · 发表于 2014-5-4 12:56:49

有个疑问，不知道对于"8"或者"日"这样形状的多线段，会不会判断不出它是自交?

/db_自贡黄明儒_ · 发表于 2014-5-4 14:06:20

llsheng_73 发表于 2014-5-4 12:56
有个疑问，不知道对于"8"或者"日"这样形状的多线段，会不会判断不出它是自交?

LZ很厉害，应该搞定了的，去年我搞了很久也没有搞定，原来他早就发布了。{:soso_e109:}

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

[多段线] 返回多段线自交点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评

点评