Comparing intersection points in a selection set

Comparing intersection points in a selection set

SORONW
Advocate Advocate
1,427 Views
7 Replies
Message 1 of 8

Comparing intersection points in a selection set

SORONW
Advocate
Advocate

I'm trying to allow a user to select a point, then perform a check to see if it's a valid intersection between all selected entities which will then return the entities that resulted in the intersection.  I'm using a modified version of Lee Mac's C:Interset http://www.lee-mac.com/intersectionfunctions.html to make this comparison.

(defun C:inttest (/ id1 id2 od1 od2)
	(setq origin (getpoint "\nSelect Origin Point"))
	(setq ss (ssget '((-4 . "<NOT") (0 . "HATCH") (-4 . "NOT>"))))
	(setq id1 (sslength ss))
	
	(while (and (not (equal origin rtnpt 0.003)) (not (equal id1 0))) 
		(setq ob1 (vlax-ename->vla-object (ssname ss (setq id1 (- id1 1)))))
		(repeat (setq id2 id1)
			(setq ob2 (vlax-ename->vla-object (ssname ss (setq id2 (1- id2)))))
			(if (setq rtnpt (car (LM:intersections ob1 ob2 acextendboth)))
				(setq rtn (cons rtnpt rtn))
			)
		)
	)
(if (not (equal origin rtnpt 0.003)) (progn (alert "Part origin not found, please try again") (Quit))) ;Parity Check
(princ "\nSuccess!")
)


;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

 In the attached drawings, I've drawn a leader pointing to the only intersection in my test document that passes the parity check. I can't seem to determine why as it should be able to pass when any intersection point is selected.

 

Any insight into why this is happening? 

0 Likes
Accepted solutions (2)
1,428 Views
7 Replies
Replies (7)
Message 2 of 8

doaiena
Collaborator
Collaborator
Accepted solution

Does this provide the expected result:

 

(defun c:test ( / pt ss fuzz ctr1 ctr2 obj1 obj2 entsLst)

(if (and
(setq pt (getpoint "\nPick a point, to check for intersections: "))
(setq ss (ssget '((-4 . "<NOT") (0 . "HATCH") (-4 . "NOT>"))))
)
(progn

(setq ctr1 0 fuzz 0.003)
(repeat (sslength ss)
(setq obj1 (vlax-ename->vla-object (ssname ss ctr1)))

(if (vlax-method-applicable-p obj1 'intersectwith)
(progn

(setq ctr2 0)
(repeat (sslength ss)
(setq obj2 (vlax-ename->vla-object (ssname ss ctr2)))
(if (vlax-method-applicable-p obj2 'intersectwith)
(if (and (equal (vlax-invoke obj1 'intersectwith obj2 acextendboth) pt fuzz)
	 (not (vl-position (list (ssname ss ctr2) (ssname ss ctr1)) entsLst))
	 )
(setq entsLst (cons (list (ssname ss ctr1) (ssname ss ctr2)) entsLst))
)
)
(setq ctr2 (1+ ctr2))
);repeat inner

));if obj1 can intersect

(setq ctr1 (1+ ctr1))
);repeat

(if entsLst
(alert (strcat "\nThese entities intersect at " (vl-princ-to-string pt) " :\n" (vl-princ-to-string entsLst)))
(alert (strcat "\nNo entities intersect at " (vl-princ-to-string pt)))
)
));if ss and pt

(princ)
);defun

 

0 Likes
Message 3 of 8

ronjonp
Mentor
Mentor

Not an answer to your question, but your selection filter can be simplified to this:

 

(setq ss (ssget '((0 . "~HATCH"))))

Just tested your code; Picked the end of the leader then selected all. It returned: 'Success!'

 

What is the purpose of this?

 

 

0 Likes
Message 4 of 8

SORONW
Advocate
Advocate

@doaienaI've only tested it a little bit, but it looks like this will work better than my approach, especially with how it handles potential multiple intersections.  Thank you for the help

 

@ronjonp 

Thanks, I never knew that the "~" could be used as a modifier like that, is that standard for selection set filters? 

 

I should have worded it more clearly, the leader was the only point where the code worked, but my understanding was that it should have succeeded at all the intersecting points of the shape. 

 

Its a segment from a larger lisp for processing a selection set to transfer coordinate data to a profile fabrication database. This segment was to define the origin point, validate it as a potential origin, and retrieve the lines that intersected  to get the relative angle of the shape.

0 Likes
Message 5 of 8

ronjonp
Mentor
Mentor
Accepted solution

@ronjonp 

Thanks, I never knew that the "~" could be used as a modifier like that, is that standard for selection set filters? 

 

Its a segment from a larger lisp for processing a selection set to transfer coordinate data to a profile fabrication database. This segment was to define the origin point, validate it as a potential origin, and retrieve the lines that intersected  to get the relative angle of the shape.


The filters are mostly common for WCMATCH input .. take a look HERE.

 

Here is some quick code to spit out intersections of a selection set .. have fun 🙂

 

(defun c:test (/ lm:intersections i o r ss)
  ;; Intersections  -  Lee Mac
  ;; Returns a list of all points of intersection between two objects
  ;; for the given intersection mode.
  ;; ob1,ob2 - [vla] VLA-Objects
  ;;     mod - [int] acextendoption enum of intersectwith method
  (defun lm:intersections (ob1 ob2 mod / lst rtn)
    (if	(and (vlax-method-applicable-p ob1 'intersectwith)
	     (vlax-method-applicable-p ob2 'intersectwith)
	     (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
	)
      (repeat (/ (length lst) 3)
	(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	      lst (cdddr lst)
	)
      )
    )
    (reverse rtn)
  )
  (if
    ;; RJP » 2020-08-26
    (and (setq ss (ssget '((0 . "~HATCH"))))
	 (setq ss (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
    )
     (progn (while (cadr ss)
	      (setq o (car ss))
	      (foreach x (setq ss (cdr ss))
		(if (setq i (lm:intersections o x acextendnone))
		  (setq r (cons i r))
		)
	      )
	    )
	    (print (apply 'append (reverse r)))
     )
  )
  (princ)
)

 

Message 6 of 8

doaiena
Collaborator
Collaborator

I like the way you set up the ss var @ronjonp . It's a bit harder to read/understand, but i admire the approach. Also, your way of cycling the objects doesn't allow for the error that i made (i check an object against itself).

 

Compact and to the point. Should be marked as a solution, as i feel the code is better than what i provided.

0 Likes
Message 7 of 8

ronjonp
Mentor
Mentor

@doaiena wrote:

I like the way you set up the ss var @ronjonp . It's a bit harder to read/understand, but i admire the approach. Also, your way of cycling the objects doesn't allow for the error that i made (i check an object against itself).

 

Compact and to the point. Should be marked as a solution, as i feel the code is better than what i provided.


Thanks for the compliment!  🍻🍻

0 Likes
Message 8 of 8

john.uhden
Mentor
Mentor

After brief testing, I found that selecting more than 2 lines fails, but selecting just 2 lines that appear to intersect is successful.  I think this is due to the repeat, which may find a qualified rtnpt for the first comparisons (say #1 and #2) but subsequently does not for #1 and #3.

Try skipping the repeat line.  Your while loop should take care of things without the repeat because it will stop at the first qualified intersection.

John F. Uhden

0 Likes