Jump to content

Compare 2 lists of entities on equal coordinates


gsc

Recommended Posts

Hi,

 

I want to to compare a list of LWPolyline entities with a list of Circle entities:

 

If the LWpolyline end point vertice XY coordinate matches a circle center coordinate XY.

Then write layer name of circle to new list.

 

If not Then return "no match"

 

 

I already have a subroutine which gets the (start) vertices of the LWpolyline.

Did try a repeat in a repeat...but that didn't work out.

So I am stucked here, something with mapcar lambda member?

 

Can somebody help me how to compare 2 lists

 

Greetzzz,

 

Gerben

Link to comment
Share on other sites

The code below allows you to select a polyline.

It then checks if there is a circle on its END-point.

If so, it moves the circle to the layer MATCHLAYER.

 

(defun C:CadTutor ( / polyline polylinex polyliney allcircles n ensel enlist circlex circley)
(setq polyline (entget (car (entsel))))
(setq polylinex (car (cdr (assoc 10 (reverse polyline)))))
(setq polyliney (car (cddr (assoc 10 (reverse polyline)))))

(setq allcircles (ssget "_X" (list (cons 0 "CIRCLE"))))
(setq n (sslength allcircles))
(repeat n
	(setq ensel (ssname allcircles (setq n (1- n)))) 
	(setq enlist (entget ensel))
	(setq circlex (car (cdr (assoc 10 enlist))))
	(setq circley (car (cdr (cdr (assoc 10 enlist)))))
	(if (and (= polylinex circlex)(= polyliney circley))
		(progn
			(princ "\nMatch found!")
			(setq enlist (subst (cons 8 "MATCHLAYER") (assoc 8 enlist) enlist))
			(entmod enlist)
		)
		(progn
			(princ "\nNo match...")
		)
	)
)
(princ)
)

Link to comment
Share on other sites

My attempt. :)

 

(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017	;;
 (if (and (or (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
              (alert "Couldn't find any circle in this drawing <!>")
              )
          (progn
            (while (setq ent (ssname sel (setq int (1+ int))))
              (setq lst (cons (list ent (cdr (assoc 10 (entget ent)))) lst))
              )
            lst
            )
          (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
          (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
          )
   (while (setq ent (ssname sel (setq int (1+ int))))
     (vl-some '(lambda (p)
                 (if (or (equal (vlax-curve-getstartpoint ent) (cadr p) 1e-4)
                         (equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                         )
                   (entmod (append (entget (car p)) '((8 . "MatchLayer"))))))
              lst)
     )
   )
 (princ)
 ) (vl-load-com)

Link to comment
Share on other sites

My attempt. :)

 

(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017    ;;
 (if (and (or (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
              (alert "Couldn't find any circle in this drawing <!>")
              )
          (progn
            (while (setq ent (ssname sel (setq int (1+ int))))
              (setq lst (cons (list ent (cdr (assoc 10 (entget ent)))) lst))
              )
            lst
            )
          (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
          (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
          )
   (while (setq ent (ssname sel (setq int (1+ int))))
     (vl-some '(lambda (p)
                 (if (or (equal (vlax-curve-getstartpoint ent) (cadr p) 1e-4)
                         (equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                         )
                   (entmod (append (entget (car p)) '((8 . "MatchLayer"))))))
              lst)
     )
   )
 (princ)
 ) (vl-load-com)

 

Thanx man, your code work smooth, however it does not exactly what I want.

I have changed it a bit to what I want to achieve:

 

(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017    ;;
           
     (setq ss2_list nil)
   (setq wtg_id2_lst nil)
   (if 
       (and
           (or
               (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
           (alert "Couldn't find any circle in this drawing <!>")
           )
           (progn
               (while (setq ent (ssname sel (setq int (1+ int))))
                   (setq ss2_list (cons (list ent (cdr (assoc 10 (entget ent)))) ss2_list))
               )
               ss2_list
           )
           
           (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
           (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       )
       (while (setq ent (ssname sel (setq int (1+ int))))
           (vl-some '(lambda (p)
               (cond ((equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           (setq wtg_id2_lst (cons (cdr (assoc 8 (entget (car p)))) wtg_id2_lst))
                       )
                       ((/= (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           
                           ; All circles are on endpoints of LWPOLYLINES
                           ; If any circle is not on any LWPOLYLINE endpoint then break the routine with an alert
                       )
               )
           )
           ss2_list)
       )
   )
   (princ)
)
(vl-load-com) 

Changes:

All circles are in separate layers

Since all circles are (or should be) on LWPOLYLINE endpoints

I want a Condition that if any LWPOLYLINE Endpoint is equal to any CIRCLE centerpoint, the Circles layer name is written to a list.

But if not equal then the routine must abort with an alert, because an x amount of circles might be moved by the CAD draftsman during modifications.

 

Your " WHILE VL-SOME LAMBDA IF" loop compares 1 LWPOLYLINE ENDpoint with all selected Circles center points...so correct me if I am wrong, if there are lets say 77 circles selected, 76 are not equal to the current LWPOLYLINE ENDpoint. however the other 76 Circles might match other LWPOLYLINE ENDpoints.

 

is this possible?

Link to comment
Share on other sites

Hi Tharwat,

 

You code runs smooth, however this is not exactly what I want.

All Circles in my drawing are on seperate layers

Also All Circles are (or should be) located on LWPOLYLINES ENDpoints (so for now I don't need the startpoint).

If this is true then the Circles layer name must be written to a list.

But your While loop compares 1 LWpolyline Endpoint with all Circles centerpoints.

So if lets say I have 77 circles in the set, 76 of them don't match the endpoint of the current LWPOLYLINE Endpoint in the loop.

However they do match other LWPOLYLINE endpoints.

What i want to achieve is that IF any of the LWPOLYLINE Endpoints matches any of the Circles center points THEN write the Circle layer name to a list

If not then an x amount of the circles are not located on an LWPOLYLINE ENDpoint (some circles might be shifted during modifications by a CAD draftsman) the routine should abort with an alert.

 

I have modified your code a bit to show what I want:

 

(defun c:Test ( / int sel ent lst )
 ;; Tharwat - Date: 11.Sep.2017    ;;
           
     (setq ss2_list nil)
   (setq wtg_id2_lst nil)
   (if 
       (and
           (or
               (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
           (alert "Couldn't find any circle in this drawing <!>")
           )
           (progn
               (while (setq ent (ssname sel (setq int (1+ int))))
                   (setq ss2_list (cons (list ent (cdr (assoc 10 (entget ent)))) ss2_list))
               )
               ss2_list
           )
           
           (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
           (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       )
       (while (setq ent (ssname sel (setq int (1+ int))))
           (vl-some '(lambda (p)
               (cond ((equal (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           (setq wtg_id2_lst (cons (cdr (assoc 8 (entget (car p)))) wtg_id2_lst))
                       )
                       ((/= (vlax-curve-getendpoint ent) (cadr p) 1e-4)
                           
                           ; All circles are (or should be) on endpoints of LWPOLYLINES
                           ; So If any circle is not on any LWPOLYLINE endpoint then break the routine with an alert
                       )
               )
           )
           ss2_list)
       )
   )
   (princ)
)
(vl-load-com)

Link to comment
Share on other sites

Something like this?

(defun c:Test ( / int sel ent lst fnd obj lys)
 ;; Tharwat - Date: 11.Sep.2017    ;;
   (if (and (or (setq int -1 sel (ssget "_X" (list '(0 . "CIRCLE") (cons 410 (getvar 'CTAB)))))
                (alert "Couldn't find any circle in this drawing <!>")
                )
           (progn
               (while (setq ent (ssname sel (setq int (1+ int))))
                   (setq lst (cons (list ent (cdr (assoc 10 (entget ent)))) lst))
               )
               lst
             )
           (princ "\nSelect LWpolylines to change circles reside on their end points to MatchLayer :")
           (setq int -1 sel (ssget '((0 . "LWPOLYLINE"))))
       )
       (while (and (not fnd) (setq ent (ssname sel (setq int (1+ int)))))
          (if (vl-some '(lambda (o) (and (equal (vlax-curve-getendpoint ent) (cadr o) 1e-4) (setq obj o))) lst)
             (setq lys (cons (cdr (assoc 8 (entget (car obj)))) lys))
                 (progn
                   (setq fnd t)
                   (alert "Found a circle not reside on any end point of a LWpolyline <!>")
                   )
            )
         )
     )
   lys
) (vl-load-com)

Link to comment
Share on other sites

Wow, works like a charm! thanx

 

Few questions about it:

1. What does the (not fnd) and (setq fnd t) in the code? When I put a semicolon before them, I still get the same result

2. same for lst after the while statement and lys after the if statement?

Link to comment
Share on other sites

Yes this is possible, but i dont know how it could fit in Tharwat's code,

since his code searches for circles that meet certain needs. And doesnt set all circles to a variable..

 

If i refer back to my code it could look something like this:

(defun C:CadTutor ( / polyline polylinex polyliney allcircles n ensel enlist circlex circley)
(setq polyline (entget (car (entsel))))
(setq polylinex (car (cdr (assoc 10 (reverse polyline)))))
(setq polyliney (car (cddr (assoc 10 (reverse polyline)))))

(setq allcircles (ssget "_X" (list (cons 0 "CIRCLE"))))
(setq n (sslength allcircles))
(repeat n
	(setq ensel (ssname allcircles (setq n (1- n)))) 
	(setq enlist (entget ensel))
	(setq circlex (car (cdr (assoc 10 enlist))))
	(setq circley (car (cdr (cdr (assoc 10 enlist)))))
	(if (and (= polylinex circlex)(= polyliney circley))
		(progn
			(princ "\nMatch found!")
			(setq enlist (subst (cons 8 "MATCHLAYER") (assoc 8 enlist) enlist))
			(entmod enlist)
                               (ssdel enlist allcircles)
		)
		(progn
			(princ "\nNo match...")
		)
	)
)
(princ)

 

after running the code the variable !allcircles will only contain all circles that are 'no match', you can do something with them in the last part of the code.

Link to comment
Share on other sites

I like the idea that if the CIRCLE objects center coordinate is equal to the end point of the LWPOLYLINE, that the item is removed from the list. This way you end up with a list which only contains the circles that were not on an end point of any LWPOLYLINE. However your example is based on 1 LWPOLYLINE, I have multiple polylines and multiple circles.

 

Here is my (partly) CODE, which was based on Tharwats last example code.

This code works: write the layer names to a list as long as any circle is on any end point of any LWPOLYLINE and terminates (with an alert) when a circle is not on an end point .

 

My idea was to use the FOREACH part (after semi collons) to remove the circle from the temp_list (nfd) when it is equal. this way you end up with a list of circles not on end points. And from there: if temp_list = 0-->write layer name, if temp_list > 0--> notify the circle layer names which are not on end points

 

But the final temp_list will only be finished after the while loop. My skills are not good enough to tackle this issue...

 

; ss1_list is list with selected LWPOLYLINES: e.g. <Entity name: 11828b00>
; ss2_list is list with selected CIRCLES: e.g. (<Entity name: 1182b2d8> (484442.36 5732452.41 0.0))
(setq int -1)
(setq nfd ss2_list)
(while
   (setq objSelection (nth (setq int (1+ int)) ss1_list))
   (if
       (vl-some '(lambda (o) (and (equal (vlax-curve-getendpoint objSelection) (cadr o) 1e-4) (setq obj o))) ss2_list)

       ;Writes layer name of the circle object to a list 
       (setq wtg_id2_lst (cons (cdr (assoc 8 (entget (car obj)))) wtg_id2_lst))
       
       ;(foreach item nfd
       ;    (if (= obj item)
       ;      (setq nfd (vl-remove item nfd))
       ;   )
        
        
       (progn
           (princ "Found a WTG not reside on any end point of a cable segment,")
       )
   )
); end while

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...