Jump to content

filtering out identical plines from a list


jeremyearle5

Recommended Posts

I'm trying to filter out plines that are duplicates of each other from a list. I've been trying to compare 1 point in the first pline against the list of points from the other plines. They will only share a point if they are identical for this use. I've been trying to work this out on my own but it has becaome a complete mess and I know there must be a simpler way. This code works but has no way of checking the last pline.

comparepts is a list of lists of the points on the plines

nubpaths is a list of the pline entity names

Help if you can please.

 

 


(setq compctr1 0
       ctr 
0
       numnubs (length 
nubpaths)
       nlist (list)
 
)


 (while (< compctr1 (- numnubs 1))
   (setq 
compctr2 (+ compctr1 1))
   (while (and (< compctr2 
numnubs) (not reject))
     (setq complngth (length 
(nth compctr2 comparepts)))
     (setq compctr3 
0)
       (while (and (< compctr3 
complngth) (not (equal (car (nth compctr1 comparepts)) (nth compctr3 (nth 
compctr2 comparepts)) 
0.00009)))
         (setq 
compctr3 (+ compctr3 1))
       ) ;_ end 
of while
       (if (/= compctr3 
complngth) 

           (setq 
reject T)
         

       ) ;_ end of 
if
   
   (setq compctr2 (+ compctr2 
1))
 
   (if (= compctr2 numnubs)  

      (setq nlist (append nlist (list (nth 
compctr1 nubpaths))))
   )
     

   ) ;_ end of while
   

   (setq compctr1 (+ compctr1 
1)
         reject 
nil
   )
 ) ;_ end of while

Link to comment
Share on other sites

You will find people are more willing to help if you responded to the time they have donated to you.

 

 

Apologies Lee. I never actually saw your reply. I think I dug the answer up somewhere else on the internet. I wish I had. It would have been very helpful. I got so caught up in trying to learn and make my code work that I moved on and forgot to look back. I have been helped by you many times though from reading your posts to others questions. Thank you for taking the time to help those of us that are still learning.

Link to comment
Share on other sites

Here is some quickly written code for you to play with:

 

(defun c:test ( / ent inc itm1 lst sel tmp vrt )

[b][color=green]    ;; Get selection of LWPolylines for testing[/color][/b]

   (if (setq sel (ssget '((0 . "LWPOLYLINE"))))
       (progn

[b]   [color=green]         ;; Collect a list of vertices for each LWPolyline[/color][/b]

           (repeat (setq inc (sslength sel))                
               (setq ent (ssname sel (setq inc (1- inc)))
                     vrt nil
               )
               (foreach pair (entget ent)
                   (if (= 10 (car pair))
                       (setq vrt (cons (cdr pair) vrt))
                   )
               )
               (setq lst (cons (list vrt ent) lst))
           )

[b][color=green]            ;; Iterate over 'lst', check for dupes[/color][/b]

           (while (setq itm1 (car lst))
               (setq
                   tmp (cdr lst)
                   lst nil
               )
               (foreach itm2 tmp

[b][color=green]                    ;; If vertex list is identical[/color][/b]
                   
                   (if (equal (car itm1) (car itm2))

     [b][color=green]                  ;; Remove from set[/color][/b]
                       
                       (ssdel (cadr itm2) sel)

[b][color=green]                        ;; Otherwise retain for further testing[/color][/b]
                       
                       (setq lst (cons itm2 lst))
                   )
               )
           )

[b][color=green]            ;; Highlight unique set[/color][/b]

           (sssetfirst nil sel)
       )
   )
   (princ)
)

Link to comment
Share on other sites

Thanks Lee. The code looks good. I called the plines identical but the vertices may not be in the exact same order. They were created with bpoly. Will this still work if the vertices are in different order.

Link to comment
Share on other sites

Thanks Lee. The code looks good. I called the plines identical but the vertices may not be in the exact same order. They were created with bpoly. Will this still work if the vertices are in different order.

 

You're welcome.

 

The above code is checking for identical LWPolylines - i.e. all vertices are the same and in the same order (though, bulge factor is not checked). For your case it may be sufficient to test whether every vertex of the test item appears in the vertex list of the second item.

Link to comment
Share on other sites

If you want to select identical entities (can be applied to any entity not only polyline), I've created this code, although entities aren't exactly identical, but they main properties are... They are clones made after commands like copy, mirror, array...

 

(defun c:selectidentical ( / ENTA N PROP1 PROP2 PROP3 PROP4 PROPLST REFENTA RPROP1 RPROP2 RPROP3 RPROP4 RPROPLST SS SSNEW ) (vl-load-com)
 (setq entA (vlax-ename->vla-object (car (entsel "\nPick reference entity"))))
 (setq prop1 (if (vlax-property-available-p entA 'Length) (vla-get-Length entA)))
 (setq prop2 (if (vlax-property-available-p entA 'Area) (vla-get-Area entA)))
 (setq prop3 (if (vlax-property-available-p entA 'Volume) (vla-get-Volume entA)))
 (setq prop4 (if (vlax-property-available-p entA 'PrincipalMoments) (vla-get-PrincipalMoments entA)))
 (if prop4 (setq prop4 (vlax-safearray->list (vlax-variant-value prop4))))
 (setq proplst (list prop1 prop2 prop3))
 (setq ssnew (ssadd))
 (setq ss (ssget "_X"))
 (repeat (setq n (sslength ss))
   (setq refentA (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
   (setq rprop1 (if (vlax-property-available-p refentA 'Length) (vla-get-Length refentA)))
   (setq rprop2 (if (vlax-property-available-p refentA 'Area) (vla-get-Area refentA)))
   (setq rprop3 (if (vlax-property-available-p refentA 'Volume) (vla-get-Volume refentA)))
   (setq rprop4 (if (vlax-property-available-p refentA 'PrincipalMoments) (vla-get-PrincipalMoments refentA)))
   (if rprop4 (setq rprop4 (vlax-safearray->list (vlax-variant-value rprop4))))
   (setq rproplst (list rprop1 rprop2 rprop3))
   (if (and (equal proplst rproplst 1e- (equal prop4 rprop4 1e-3)) (ssadd (vlax-vla-object->ename refentA) ssnew))
 )
 (sssetfirst nil ssnew)
 (alert (strcat "\nTotal : " (itoa (sslength ssnew)) " identical entity(ies)"))
 (princ)
)

 

I've found this code very useful in process of working in ACAD...

M.R.:geek:

Link to comment
Share on other sites

I would suggest the use of OVERKILL, to those who have it as a very good pre-emptive way to root out redundancy while still in your drawing, always nice to tidy up before saving.

Edited by Dadgad
Link to comment
Share on other sites

Forgive my asking, but what does my post have to do with that suggestion? I was commenting on the potential for (vlax-ename->vla-object nil).

Link to comment
Share on other sites

Sorry RenderMan, absolutely nothing, It was more directed to a preemptive treatment of the whole issue, in general. I did not understand the reference you were making, and thought that it was of a more general nature as well. :beer:

Link to comment
Share on other sites

No worries, my friend.

 

Sometimes my ambiguity is better received than a direct quote of a particular line of code for those to which my post refers.

 

Cheers! :beer:

Link to comment
Share on other sites

  • 2 weeks later...

Thanks M.R. This looks like it could be potentially useful to me. I just got back from vacation, so thanks for the help everyone.

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...