判断两图元是否相交，相交则无任何操作，不相交则判断两图元是否延伸相交，如延伸...

fangmin723

其实很简单，用延伸也可以达到这种效果！

1. ;;说明:判断两图元是否相交，相交则无任何操作，不相交则判断两图元是否延伸相交，如延伸相交，则延伸entname1至entname2最近点
   
2. ;;返回:相交则提示相交，不相交且延伸相交则返回延伸相交点，否则则提示图元无相交点
   
3. (defun C:ifcro(/ bf-list-split data enpt ent1 ent2 extendpt lst ptlst var);BY-忘霄-qq：702099480(2018.10.8)
   
4.   (defun BF-list-split (lst x / lst2);BY 落魄山人-qq：403009819
   
5.     (foreach n lst
   
6.       (if  (and lst2 (/= x (length (car lst2))))
   
7.         (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))
   
8.         (setq lst2 (cons (list n) lst2))
   
9.       )
   
10.     )
    
11.     (reverse lst2)
    
12.   )
    
13.   (setq
    
14.     ent1 (vlax-ename->vla-object (car (entsel "\n选择对象1或延伸对象：")))
    
15.     ent2 (vlax-ename->vla-object (car (entsel "\n选择对象2或被延伸对象：")))
    
16.   )
    
17.   (if (not (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-IntersectWith ent1 ent2 acExtendNone)) 1) 1));判断两图元是否相交
    
18.     (if (> (vlax-safearray-get-u-bound (setq var (vlax-variant-value (vla-IntersectWith ent1 ent2 acExtendBoth))) 1) 1);判断两图元是否延伸相交
    
19.       (progn
    
20.         (setq
    
21.           lst (BF-list-split (vlax-safearray->list var) 3)
    
22.           enpt (car lst)
    
23.           ptlst (mapcar '(lambda(x) (cdr x)) (vl-remove-if-not '(lambda(x) (= (car x) 10)) (setq data (entget (vlax-vla-object->ename ent1)))))
    
24.         )
    
25.         (if (equal (angle (nth 1 ptlst) (nth 0 ptlst)) (angle (nth 0 ptlst) enpt) 1e-8)
    
26.           (progn
    
27.             (setq
    
28.               extendpt (cdr (assoc 10 data))
    
29.               lst (vl-sort lst '(lambda(a b) (< (distance extendpt a) (distance extendpt b))))
    
30.               enpt (car lst)
    
31.             )
    
32.             (entmod (setq data (subst (cons 10 enpt) (assoc 10 data) data)))
    
33.           )
    
34.           (progn
    
35.             (setq
    
36.               extendpt (cdr (assoc 10 data))
    
37.               lst (vl-sort lst '(lambda(a b) (< (distance extendpt a) (distance extendpt b))))
    
38.               enpt (car lst)
    
39.               data (reverse data)
    
40.               data (reverse (subst (cons 10 enpt) (assoc 10 data) data))
    
41.             )
    
42.             (entmod data)
    
43.           )
    
44.         )
    
45.         (prompt (strcat "\n两图元延伸后最近相交于点" (vl-prin1-to-string enpt) "！"))
    
46.       )
    
47.       (prompt "\n两图元无相交点！")
    
48.     )
    
49.     (prompt "\n两图元相交！")
    
50.   )
    
51.   (prin1)
    
52. )

;;说明:判断两图元是否相交，相交则无任何操作，不相交则判断两图元是否延伸相交，如延伸相交，则延伸entname1至entname2最近点<br /> ;;返回:相交则提示相交，不相交且延伸相交则返回延伸相交点，否则则提示图元无相交点<br /> (defun C:ifcro(/ bf-list-split data enpt ent1 ent2 extendpt lst ptlst var);BY-忘霄-qq：702099480(2018.10.8)<br />   (defun BF-list-split (lst x / lst2);BY 落魄山人-qq：403009819<br />     (foreach n lst<br />       (if  (and lst2 (/= x (length (car lst2))))<br />         (setq lst2 (cons (append (car lst2) (list n)) (cdr lst2)))<br />         (setq lst2 (cons (list n) lst2))<br />       )<br />     )<br />     (reverse lst2)<br />   )<br />   (setq<br />     ent1 (vlax-ename->vla-object (car (entsel "\n选择对象1或延伸对象：")))<br />     ent2 (vlax-ename->vla-object (car (entsel "\n选择对象2或被延伸对象：")))<br />   )<br />   (if (not (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-IntersectWith ent1 ent2 acExtendNone)) 1) 1));判断两图元是否相交<br />     (if (> (vlax-safearray-get-u-bound (setq var (vlax-variant-value (vla-IntersectWith ent1 ent2 acExtendBoth))) 1) 1);判断两图元是否延伸相交<br />       (progn<br />         (setq<br />           lst (BF-list-split (vlax-safearray->list var) 3)<br />           enpt (car lst)<br />           ptlst (mapcar '(lambda(x) (cdr x)) (vl-remove-if-not '(lambda(x) (= (car x) 10)) (setq data (entget (vlax-vla-object->ename ent1)))))<br />         )<br />         (if (equal (angle (nth 1 ptlst) (nth 0 ptlst)) (angle (nth 0 ptlst) enpt) 1e-8)<br />           (progn<br />             (setq <br />               extendpt (cdr (assoc 10 data))<br />               lst (vl-sort lst '(lambda(a b) (< (distance extendpt a) (distance extendpt b))))<br />               enpt (car lst)<br />             )<br />             (entmod (setq data (subst (cons 10 enpt) (assoc 10 data) data)))<br />           )<br />           (progn<br />             (setq<br />               extendpt (cdr (assoc 10 data))<br />               lst (vl-sort lst '(lambda(a b) (< (distance extendpt a) (distance extendpt b))))<br />               enpt (car lst)<br />               data (reverse data) <br />               data (reverse (subst (cons 10 enpt) (assoc 10 data) data))<br />             )<br />             (entmod data)<br />           )<br />         )<br />         (prompt (strcat "\n两图元延伸后最近相交于点" (vl-prin1-to-string enpt) "！"))<br />       )<br />       (prompt "\n两图元无相交点！")<br />     )<br />     (prompt "\n两图元相交！")<br />   )<br />   (prin1)<br /> )

fangmin723

烟盒迷唇 发表于 2018-10-9 20:08
不符合我的需要，我想框选智能识别，这样点选的话我直接用延伸就可以了

少年，我承认是看到你发的帖子才写的代码，但是你需要明白，我这不是为你特意定制的，OK？？？不符合你的要求，你可以根据自己的需要，自己修改，如果不想修改的话，可以找别人在我的基础上去定制，ok？！

fangmin723

lifuq1979 发表于 2018-10-9 18:47
看大神动图方框内点第二条线时出错了，原线没有了，只有延伸的部分

这点需要做个判断，我只是简单的写了一下，因为相对而言两个延伸的焦点，那个距离比较近，就会把坐标改变到那个位置！没有做判断，只要再加个判断就好了！

flowerson

fangmin723 发表于 2018-10-11 08:12
你是来打酱油的吧

sorry，因为回复了才能看到。因为是那种那种压缩的vlx文件或者fas。现在知道了。是lsp

669423907

谢谢fangmin723大师分享

烟盒迷唇

先选中了被延伸对象就会出错，不过也很好了

fangmin723

烟盒迷唇 发表于 2018-10-8 19:58
先选中了被延伸对象就会出错，不过也很好了

这个如果你需要无视顺序，你自己可以改一下

lifuq1979

看大神动图方框内点第二条线时出错了，原线没有了，只有延伸的部分

烟盒迷唇

不符合我的需要，我想框选智能识别，这样点选的话我直接用延伸就可以了

JHX948954875

谢谢楼主分享

原地踏步

正好需要这方面资料，谢谢楼主分享。