（XD::Curve:Relation）两条曲线的8种拓扑关系判断

Lispboy · 发表于 2018-12-23 18:03:50

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

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

×

本帖最后由 newer 于 2018-12-24 09:46 编辑

8种关系
0：内部
1：内部贴合
2：相交
3：外部贴合
4：外部
5：内部相贴有缝隙
6：外部相贴有缝隙
7：内部但距离小于容差，容差值由 (xdrx_setvar "toldist" dist）设定
8：外部但距离小于容差，容差值由 (xdrx_setvar "toldist" dist）设定

（XD::Curve:Relation）两条曲线的8种拓扑关系判断-1.png

(defun XD::Curve:Relation (e1 e2 / cfgs cfgs1 g1 g2 gint ints isGe isinnor is-inters isMInters
isnear isqua item numints ret verts1 verts2 x
)
(cond ((XdGe::IsKindOf e1 "kCurve3d")
(setq g1 e1
isGe t
)
)
((= (type e1) 'ENAME) (setq g1 (xdge::constructor e1)))
((= (type e1) 'LIST)
(setq g1 (xdge::constructor "kCompositeCrv3d" e1))
)
)
(cond ((XdGe::IsKindOf e2 "kCurve3d")
(setq g2 e2
isGe t
)
)
((= (type e2) 'ENAME) (setq g2 (xdge::constructor e2)))
((= (type e2) 'LIST)
(setq g2 (xdge::constructor "kCompositeCrv3d" e2))
)
)
(if (and g1
g2
(setq gint (xdge::Constructor "kCurveCurveInt3d" g1 g2))
)
(progn (setq numints (xdge::getpropertyvalue gint "numintpoints"))
(setq verts2 (xdrx_getpropertyvalue g2 "vertices")
verts1 (xdrx_getpropertyvalue g1 "vertices")
isnear (< (xdge::getpropertyvalue g1 "distanceto" g2)
(xdrx_getvar "toldist")
)
isinnor (vl-some '(lambda (x) (xdrx_point_isinside x e2)) verts1)
)
(cond ((= numints 0)
(if isinnor
(progn (setq ret 0)
(if isnear
(setq ret 7)
)
)
(progn (setq ret 4)
(if isnear
(setq ret 8)
)
)
)
)
((> numints 0)
(setq ints (xdge::getpropertyvalue gint "intpoints")
cfgs (mapcar '(lambda (x)
(xdge::getpropertyvalue gint "getintconfigs" x t)
)
(xd::list:intarrays 0 (1- (length ints)))
)
item (xdrx_string_replace
(substr (strcase (caar cfgs)) 2)
"OVERLAP"
""
)
cfgs1 (strcase (apply 'strcat (mapcar 'car cfgs)))
is-inters (and (xdrx_string_regexps "left" cfgs1)
(xdrx_string_regexps "right" cfgs1)
)
isqua (and (> (length ints) 1)
(or (not (xdrx_string_regexps "OVERLAP" cfgs1))
(and (setq cfgs1 (xdrx_string_regexps item cfgs1))
(> (length cfgs1) 2)
)
)
)
isMInters (> (length ints) 1)
)
(cond (is-inters (setq ret 2))
(isinnor
(setq ret 1)
(if (and isMInters isqua)
(setq ret 5)
)
)
(t
(setq ret 3)
(if (and isMInters isqua)
(setq ret 6)
)
)
)
)
)
(if (not isGe)
(xdge::free g1 g2)
)
(xdge::free gint)
)
)
ret
)

(defun XD::Curve:Relation (e1 e2 / cfgs cfgs1 g1 g2 gint ints isGe isinnor is-inters isMInters 
                           isnear isqua item numints ret verts1 verts2 x 
                          ) 
  (cond ((XdGe::IsKindOf e1 "kCurve3d") 
         (setq g1 e1 
               isGe t 
         ) 
        ) 
        ((= (type e1) 'ENAME) (setq g1 (xdge::constructor e1))) 
        ((= (type e1) 'LIST) 
         (setq g1 (xdge::constructor "kCompositeCrv3d" e1)) 
        ) 
  ) 
  (cond ((XdGe::IsKindOf e2 "kCurve3d") 
         (setq g2 e2 
               isGe t 
         ) 
        ) 
        ((= (type e2) 'ENAME) (setq g2 (xdge::constructor e2))) 
        ((= (type e2) 'LIST) 
         (setq g2 (xdge::constructor "kCompositeCrv3d" e2)) 
        ) 
  ) 
  (if (and g1 
           g2 
           (setq gint (xdge::Constructor "kCurveCurveInt3d" g1 g2)) 
      ) 
    (progn (setq numints (xdge::getpropertyvalue gint "numintpoints")) 
           (setq verts2  (xdrx_getpropertyvalue g2 "vertices") 
                 verts1  (xdrx_getpropertyvalue g1 "vertices") 
                 isnear  (< (xdge::getpropertyvalue g1 "distanceto" g2) 
                            (xdrx_getvar "toldist") 
                         ) 
                 isinnor (vl-some '(lambda (x) (xdrx_point_isinside x e2)) verts1) 
           ) 
           (cond ((= numints 0) 
                  (if isinnor 
                    (progn (setq ret 0) 
                           (if isnear 
                             (setq ret 7) 
                           ) 
                    ) 
                    (progn (setq ret 4) 
                           (if isnear 
                             (setq ret 8) 
                           ) 
                    ) 
                  ) 
                 ) 
                 ((> numints 0) 
                  (setq ints      (xdge::getpropertyvalue gint "intpoints") 
                        cfgs      (mapcar '(lambda (x) 
                                             (xdge::getpropertyvalue gint "getintconfigs" x t) 
                                           ) 
                                          (xd::list:intarrays 0 (1- (length ints))) 
                                  ) 
                        item      (xdrx_string_replace 
                                    (substr (strcase (caar cfgs)) 2) 
                                    "OVERLAP" 
                                    "" 
                                  ) 
                        cfgs1     (strcase (apply 'strcat (mapcar 'car cfgs))) 
                        is-inters (and (xdrx_string_regexps "left" cfgs1) 
                                       (xdrx_string_regexps "right" cfgs1) 
                                  ) 
                        isqua     (and (> (length ints) 1) 
                                       (or (not (xdrx_string_regexps "OVERLAP" cfgs1)) 
                                           (and (setq cfgs1 (xdrx_string_regexps item cfgs1)) 
                                                (> (length cfgs1) 2) 
                                           ) 
                                       ) 
                                  ) 
                        isMInters (> (length ints) 1) 
                  ) 
                  (cond (is-inters (setq ret 2)) 
                        (isinnor 
                         (setq ret 1) 
                         (if (and isMInters isqua) 
                           (setq ret 5) 
                         ) 
                        ) 
                        (t 
                         (setq ret 3) 
                         (if (and isMInters isqua) 
                           (setq ret 6) 
                         ) 
                        ) 
                  ) 
                 ) 
           ) 
           (if (not isGe) 
             (xdge::free g1 g2) 
           ) 
           (xdge::free gint) 
    ) 
  ) 
  ret 
)

yangjian001 · 发表于 2018-12-24 08:51:24

授人以鱼不如授人以渔

csy0415 · 发表于 2018-12-24 09:14:35

很好的功能，谢谢大师分享！

yuanziyou · 发表于 2021-5-19 13:09:45

请问能用lisp实现吗

Le9988 · 发表于 2021-6-17 10:16:21

学习，学习。

zteykmgscqh · 发表于 2021-7-1 02:24:05

好贴，内部有几个函数需要专用函数库

chengjie1991911 · 发表于 2024-4-12 09:24:20

先学习学习哈

月之圣痕 · 发表于 2024-4-23 15:10:49

.net如何实现呢。。。

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

[曲线] （XD::Curve:Relation）两条曲线的8种拓扑关系判断

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