判断pl线自相交

aeo · 发表于 2013-11-27 23:49:58

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

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

×

;;自相交? 不自相交返回T
(defun rrr(e / ret1 ret2 )
(setq e(vlax-ename->vla-object e))
(and
(setq ret1(vl-catch-all-apply 'vlax-invoke (list e 'offset 0.0001)))
(not(vl-catch-all-error-p ret1))
(progn(mapcar 'vla-delete ret1)t)
(= 1(length ret1))
(setq ret2(vl-catch-all-apply 'vlax-invoke (list e 'offset -0.0001)))
(not(vl-catch-all-error-p ret2))
(progn(mapcar 'vla-delete ret2)t)
(= 1(length ret2))
)
)

测试一下有无问题:P

st788796 · 发表于 2013-11-28 00:04:14

测试通过,不过发现一个有趣现象, 距离极小时夹点没了,妥当那个 grip 点是整根线移动

/db_自贡黄明儒_ · 发表于 2013-11-28 09:46:33

本帖最后由 /db_自贡黄明儒_ 于 2013-11-28 11:42 编辑

无论是否自相交，均返回T,这是为什么呢？

牢固 · 发表于 2013-11-28 13:34:44

本帖最后由牢固于 2013-12-2 10:50 编辑

测试结果是自交和不自交均返回T!
我给出另一版本的计算多段线自交函数：

;多段线是否自交 By Gu_xl
;;(gxl-PlSelfIntersP (car(entsel)))
(defun GXL-PLSELFINTERSP
(PL / CMD OBJS TMP FLAG OBJ P0 P1 OBJS1 OBJ1 P2 P3 LST SS ENDENT)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (> (atoi (getvar 'acadver)) 16)
(progn
(setq PEDITACCEPT (getvar 'PEDITACCEPT))
(setvar 'PEDITACCEPT 0)
)
)
(if (= 'ename (type pl))
(setq pl (vlax-ename->vla-object pl))
)
(setq objs (vlax-safearray->list (vlax-variant-value (vla-explode pl)))
tmp objs
)
(setq flag nil)
(while (and objs (not flag))
(setq obj (car objs)
p0 (vlax-curve-getStartPoint obj)
p1 (vlax-curve-getEndPoint obj)
objs (cdr objs)
objs1 objs
)
(while (and (not flag)
objs1
)
(setq obj1 (car objs1)
p2 (vlax-curve-getStartPoint obj1)
p3 (vlax-curve-getEndPoint obj1)
objs1 (cdr objs1)
)
(setq lst (vlax-invoke obj 'IntersectWith obj1 acExtendNone))
(if lst
(progn
(setq lst (GXL-LST-SPLIT lst 3))
(setq lst
(vl-remove-if
'(lambda (x)
(and
(or
(equal p0 x 1e-6)
(equal p1 x 1e-6)
)
(or
(equal p2 x 1e-6)
(equal p3 x 1e-6)
)
)
)
lst
)
)
(setq flag (> (length lst) 0))
)
)
)
)
(if (not flag)
(progn
(setq ss (ssadd))
(foreach o tmp
(ssadd (vlax-vla-object->ename o) ss)
)
(setq endent (entlast))
(command "_pedit" "m" ss "" "y" "j" "" "")
(setq ss (ssadd))
(while (setq endent (entnext endent))
(ssadd endent ss)
)
(setq flag (> (sslength ss) 1))
(command "_erase" ss "")
(if (> (atoi (getvar 'acadver)) 16)
(progn
(setvar 'PEDITACCEPT PEDITACCEPT)
)
)
(setvar 'cmdecho cmd)
flag
)
(progn
(mapcar 'vla-delete tmp)
(if (> (atoi (getvar 'acadver)) 16)
(progn
(setvar 'PEDITACCEPT PEDITACCEPT)
)
)
(setvar 'cmdecho cmd)
t
)
)
)(defun gxl-lst-split (lst len / tmp)
(if lst
(cons
(reverse
(repeat len
(if (car lst)
(setq tmp (cons (car lst) tmp)
lst (cdr lst)
)
)
tmp ;_ 制造返回值
)
)
(gxl-lst-split lst len)
)
)
)

;多段线是否自交 By Gu_xl 
;;(gxl-PlSelfIntersP (car(entsel))) 
(defun GXL-PLSELFINTERSP 
  (PL /        CMD OBJS TMP FLAG OBJ P0 P1 OBJS1 OBJ1 P2 P3 LST SS ENDENT) 
  (setq cmd (getvar 'cmdecho)) 
  (setvar 'cmdecho 0) 
  (if (>  (atoi (getvar 'acadver)) 16) 
    (progn 
      (setq PEDITACCEPT (getvar 'PEDITACCEPT)) 
      (setvar 'PEDITACCEPT 0) 
      ) 
    ) 
  (if (= 'ename (type pl)) 
    (setq pl (vlax-ename->vla-object pl)) 
  ) 
  (setq        objs (vlax-safearray->list (vlax-variant-value (vla-explode pl))) 
        tmp  objs 
  ) 
  (setq flag nil) 
  (while (and objs (not flag)) 
    (setq obj        (car objs) 
          p0        (vlax-curve-getStartPoint obj) 
          p1        (vlax-curve-getEndPoint obj) 
          objs        (cdr objs) 
          objs1        objs 
    ) 
    (while (and        (not flag) 
                objs1 
           ) 
      (setq obj1  (car objs1) 
            p2          (vlax-curve-getStartPoint obj1) 
            p3          (vlax-curve-getEndPoint obj1) 
            objs1 (cdr objs1) 
      ) 
      (setq lst (vlax-invoke obj 'IntersectWith obj1 acExtendNone)) 
      (if lst 
        (progn 
          (setq lst (GXL-LST-SPLIT lst 3)) 
          (setq        lst 
                 (vl-remove-if 
                   '(lambda (x) 
                      (and 
                        (or 
                          (equal p0 x 1e-6) 
                          (equal p1 x 1e-6) 
                        ) 
                        (or 
                          (equal p2 x 1e-6) 
                          (equal p3 x 1e-6) 
                        ) 
                      ) 
                    ) 
                   lst 
                 ) 
          ) 
          (setq flag (> (length lst) 0)) 
        ) 
      ) 
 
    ) 
  ) 
  (if (not flag) 
    (progn 
      (setq ss (ssadd)) 
      (foreach o tmp 
        (ssadd (vlax-vla-object->ename o) ss) 
      ) 
      (setq endent (entlast)) 
      (command "_pedit" "m" ss "" "y" "j" "" "") 
      (setq ss (ssadd)) 
      (while (setq endent (entnext endent)) 
        (ssadd endent ss) 
      ) 
      (setq flag (> (sslength ss) 1)) 
      (command "_erase" ss "") 
      (if (> (atoi (getvar 'acadver)) 16) 
        (progn 
          (setvar 'PEDITACCEPT PEDITACCEPT) 
        ) 
      ) 
      (setvar 'cmdecho cmd) 
 
      flag 
    ) 
    (progn 
      (mapcar 'vla-delete tmp) 
      (if (> (atoi (getvar 'acadver)) 16) 
        (progn 
          (setvar 'PEDITACCEPT PEDITACCEPT) 
        ) 
      ) 
      (setvar 'cmdecho cmd) 
      t 
    ) 
  ) 
)(defun gxl-lst-split (lst len / tmp) 
  (if lst 
    (cons 
      (reverse 
        (repeat        len 
          (if (car lst) 
            (setq tmp (cons (car lst) tmp) 
                  lst (cdr lst) 
            ) 
          ) 
          tmp ;_ 制造返回值 
        ) 
      ) 
      (gxl-lst-split lst len) 
    ) 
  ) 
)

/db_自贡黄明儒_ · 发表于 2013-11-28 13:52:32

牢固发表于 2013-11-28 13:34
测试结果是自交和不自交均返回T!
我给出另一版本的计算多段线自交函数：

G版，运行出错，找不到原因

st788796 · 发表于 2013-11-28 13:55:55

是不是判断能否生成 Region 也可以, 当然Open的先行 Close

牢固 · 发表于 2013-11-28 14:16:00

/db_自贡黄明儒_ 发表于 2013-11-28 13:52
G版，运行出错，找不到原因

系统变量 peditaccept的问题！楼上代码已修正！

牢固 · 发表于 2013-11-28 14:18:58

st788796 发表于 2013-11-28 13:55
是不是判断能否生成 Region 也可以, 当然Open的先行 Close

这种方法不靠谱！开口不自交的多段线，封口后有可能就会自交！所以很难判断！

aeo · 发表于 2013-11-29 21:56:19

/db_自贡黄明儒_ 发表于 2013-11-28 09:46
无论是否自相交，均返回T,这是为什么呢？

我测试了很多条线都可以判断，

pl线最后一点如果没回到起点，只要在某一线上就应该是 nil
中间画的过程中碰到自己，也应该是nil

你贴个图上来,哪种情况不对

aeo · 发表于 2013-11-29 22:05:40

其实很简单，自己用offset命令试验，距离可以设大一点就可以看清，往两个方向offset
如果自相交是offset不出一条完整的线的，至少有一个方向不行。
这种判断，桌子公司写offset的时候已经考虑的很清楚了，你如果自定义实体重载offset方法，一样的也要想的很充分。
所以我们没必要自己动脑筋。

st788796 · 发表于 2013-11-29 22:20:37

aeo 发表于 2013-11-29 22:05
其实很简单，自己用offset命令试验，距离可以设大一点就可以看清，往两个方向offset
如果自相交是offset不 ...

xdrx_curve_getoffsetcurve 和 Offset 是一样的

/db_自贡黄明儒_ · 发表于 2013-11-30 08:12:54

aeo版主请看，不论是否自交，返回的结果不对

zyhandw · 发表于 2013-11-30 14:59:04

牢固发表于 2013-11-28 13:34
测试结果是自交和不自交均返回T!
我给出另一版本的计算多段线自交函数：

错误: no function definition: GXL-LST-SPLIT，G版，提示还缺少GXL-LST-SPLIT函数

牢固 · 发表于 2013-12-2 11:11:26

本帖最后由牢固于 2013-12-2 11:13 编辑

zyhandw 发表于 2013-11-30 14:59
错误: no function definition: GXL-LST-SPLIT，G版，提示还缺少GXL-LST-SPLIT函数

楼上 GXL-LST-SPLIT 函数已补上！
根据VLA-offset函数特性，给出另一版本的判断自交代码：

(defun GXL-PLSELFINTERSP (pl / err err1 flag)
(if (= 'ename (type pl))
(setq pl (vlax-ename->vla-object pl))
)
(if
(not
(VL-CATCH-ALL-ERROR-P
(setq err (VL-CATCH-ALL-APPLY 'vla-Offset (list pl 0.001)))
)
)
(progn
(setq err (vlax-safearray->list (vlax-variant-value err)))
(if (> (length err) 1)
(progn
(mapcar 'vla-delete err)
t
)
(if (not
(VL-CATCH-ALL-ERROR-P
(setq err1 (VL-CATCH-ALL-APPLY
'vla-Offset
(list (car err) -0.001)))
)
)
(progn
(setq err1 (vlax-safearray->list
(vlax-variant-value err1)))
(setq flag (not
(equal
(vla-get-length pl)
(vla-get-length (car err1))
1e-8
)
)
)
(mapcar 'vla-delete err)
(mapcar 'vla-delete err1)
flag
)
(princ "\nFailed!")
)
)
)
(princ "\nFailed!")
)
)

(defun GXL-PLSELFINTERSP  (pl / err err1 flag) 
  (if (= 'ename (type pl)) 
    (setq pl (vlax-ename->vla-object pl)) 
    ) 
  (if 
    (not 
      (VL-CATCH-ALL-ERROR-P 
        (setq err (VL-CATCH-ALL-APPLY 'vla-Offset (list pl 0.001))) 
        ) 
      ) 
     (progn 
       (setq err (vlax-safearray->list (vlax-variant-value err))) 
       (if (> (length err) 1) 
         (progn 
           (mapcar 'vla-delete err) 
           t 
           ) 
         (if (not 
               (VL-CATCH-ALL-ERROR-P 
                 (setq err1 (VL-CATCH-ALL-APPLY 
                              'vla-Offset 
                              (list (car err) -0.001))) 
                 ) 
               ) 
           (progn 
             (setq err1        (vlax-safearray->list 
                          (vlax-variant-value err1))) 
             (setq flag        (not 
                          (equal 
                            (vla-get-length pl) 
                            (vla-get-length (car err1)) 
                            1e-8 
                            ) 
                          ) 
                   ) 
             (mapcar 'vla-delete err) 
             (mapcar 'vla-delete err1) 
             flag 
             ) 
           (princ "\nFailed!") 
           ) 
         ) 
       ) 
     (princ "\nFailed!") 
     ) 
  )

zyhandw · 发表于 2013-12-2 16:55:58

牢固发表于 2013-12-2 11:11
楼上 GXL-LST-SPLIT 函数已补上！
根据VLA-offset函数特性，给出另一版本的判断自交代码：

感谢固版的分享，回去学习下。试用了下，根据VLA-offset函数特性的另一版本更好些，4楼修正后的还是有一些问题。比如这种情况：

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

[每日一码] 判断pl线自相交

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

点评

点评

点评

点评

点评

点评

点评

评分