Intersecting Objects Lines/Arcs/Mlines

All,

I am trying to find the intersection points of two sets of selected objects.

Refer to the code below to create the sets:

(defun Get_Duct_on_Top (/
		Duct_on_Top_List
		Duct_on_Top
		Duct_Members
		Instance_count
		Ent
		)
 (princ "\nSelect Ductwork on Top: ")
 (setq Duct_on_Top (ssget))
 (setq Duct_Members (sslength Duct_on_Top))
 (setq Instance_count 0)
 (while (< Instance_count Duct_Members)
   (setq Ent (ssname Duct_on_top Instance_Count))
   (if Duct_on_Top_List
     (setq Duct_on_Top_List (append (list Ent) Duct_on_Top_List))
     (setq Duct_on_Top_List (list Ent)))
   (setq Instance_Count (1+ Instance_Count)))
 Duct_on_Top_List
 )

(defun Get_Duct_Below (/
	       Duct_on_Bottom
	       Duct_Members
	       Instance_count
	       Duct_on_Bottom_List
	       Ent
	       )
 (princ "\nSelect Ductwork on Bottom: ")
 (setq Duct_on_Bottom (ssget))
 (setq Duct_Members (sslength Duct_on_Bottom))
 (setq Instance_count 0)
 (while (< Instance_count Duct_Members)
   (setq Ent (ssname Duct_on_Bottom Instance_Count))
   (if Duct_on_Bottom_List
     (setq Duct_on_Bottom_List (append (list Ent) Duct_on_Bottom_List))
     (setq Duct_on_Bottom_List (list Ent)))
   (setq Instance_Count (1+ Instance_Count)))
 Duct_on_Bottom_List
 )

(setq Top_Duct_List (Get_Duct_on_Top))
(setq Duct_Below_List (Get_Duct_Below))

Above and Below Relationships.dwg

This function will return a list of intersections between two selection sets:

;;------------=={ Intersections Between Sets }==--------------;;
;;                                                            ;;
;;  Returns a list of all intersections between objects in    ;;
;;  two selection sets.                                       ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ss1,ss2 - SelectionSets to process                        ;;
;;------------------------------------------------------------;;
;;  Returns:  List of 3D points, else nil                     ;;
;;------------------------------------------------------------;;

(defun LM:IntersectionsBetweenSets ( ss1 ss2 / i j o1 o2 lst )
 (repeat (setq i (sslength ss1))
   (setq o1 (vlax-ename->vla-object (ssname ss1 (setq i (1- i)))))
   (repeat (setq j (sslength ss2))
     (setq o2  (vlax-ename->vla-object (ssname ss2 (setq j (1- j))))
           lst (cons (LM:GroupByNum (vlax-invoke o1 'IntersectWith o2 acExtendNone) 3) lst)
     )
   )
 )
 (apply 'append lst)
)

;;-----------------=={ Group by Number }==--------------------;;
;;                                                            ;;
;;  Groups a list into a list of lists, each of length 'n'    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  l - List to process                                       ;;
;;  n - Number of elements by which to group the list         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of lists, each of length 'n'               ;;
;;------------------------------------------------------------;;

(defun LM:GroupByNum ( l n / r)
 (if l
   (cons
     (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
     (LM:GroupByNum l n)
   )
 )
)

Test function:

(defun c:test ( / s1 s2 ) (vl-load-com)
 (if
   (and
     (setq s1 (ssget))
     (setq s2 (ssget))
   )
   (foreach x (LM:IntersectionsBetweenSets s1 s2)
     (entmakex (list (cons 0 "POINT") (cons 10 x)))
   )
 )
 (princ)
)

More intersection functions here.

Nice I was trying to get intersections using inters function. I have used 'intersectwith before but more recently inters. Thanks Lee. And thanks for the list intersections as well.

Matt

You're very welcome Matt

Hey Lee, Is there a better way to explode a MLINE than using (command "explode" mline "")? It is pretty slow!

Additionally,

Is it possible to identify if a point lies between two points?

All,

I have rewrote my program to include the intersectwith method. I am hitting some trouble with MLINE & Arc support. I am going to continue working on the program, however, maybe someone may be able to contribute some of their thoughts.

(defun c:brd ( /
      s1
      s2
      below_member
      obj
      above_member
      ints
      int_lst
      line
      )
 
 (vla-StartUndoMark(vla-get-ActiveDocument(vlax-get-acad-object)))
 
 (while (progn
   (princ "\nSpecify Ductwork running above: ")
   (not (setq s1 (ssget))))
   (princ "\nExpects a selection, try again: "))
 (while (progn
   (princ "\nSpecify Ductwork running below: ")
   (not (setq s2 (ssget))))
   (princ "\nExpects a selection, try again: "))
 
 (setq below_member 0)
 (while (< below_member (sslength s2))
   (setq obj (vlax-ename->vla-object (ssname s2 below_member)))
   (setq above_member 0)
   (while (< above_member (sslength s1))
     (if (setq ints (vlax-invoke obj 'intersectwith (vlax-ename->vla-object (ssname s1 above_member)) acExtendNone))
(if ints
  (if int_lst
    (setq int_lst (append (list ints) int_lst))
    (setq int_lst (list ints)))
  t)
t)
     (setq above_member (1+ above_member)))
   
   (not(command "_.break" (list (ssname s2 below_member) (car int_lst)) "First" (car int_lst) (cadr int_lst)))
   (setq line (entmakex
	 (list
	   (cons 0 "line")
	   (cons 100 "AcDbLine")
	   (cons 8 (cdr (assoc 8 (entget (ssname s2 below_member)))))
	   (cons 48 (/ (getvar 'celtscale) 2))
	   (cons 10 (polar (car int_lst) (angle (car int_lst) (cadr int_lst)) (* (getvar 'celtscale) 0.0475)))
	   (cons 11 (polar (cadr int_lst) (angle (cadr int_lst) (car int_lst)) (* (getvar 'celtscale) 0.0475)))
	   )
	 )
  )
   (if (tblsearch "LTYPE" "Hidden2")
     (not (vla-put-linetype (vlax-ename->vla-object line) "Hidden2"))
     (princ "\nHidden2 Linetype is not loaded, please load"))
   (setq int_lst nil)
   (setq below_member (1+ below_member)))
   (vla-endUndoMark(vla-get-ActiveDocument(vlax-get-acad-object)))
 (princ)
)

The drawing file is located on the initial post.

Kind Regards,

Matt