马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 newer 于 2018-12-24 09:46 编辑
8种关系
0:内部
1:内部贴合
2:相交
3:外部贴合
4:外部
5:内部相贴有缝隙
6:外部相贴有缝隙
7:内部但距离小于容差,容差值由 (xdrx_setvar "toldist" dist)设定
8:外部但距离小于容差,容差值由 (xdrx_setvar "toldist" dist)设定
 - (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
- )
|