Jump to content

loop to remove duplicate items from a selection set


Hardeight

Recommended Posts

I am banging my head against the wall trying to get this loop to work.

I almost have it working as long as there are even numbers of duplicates in the list. As soon as it gets and odd number it goes haywire and doesn't filter out my selection set correctly. Here is what I have so far ..

 

(setq endlist (sslength ssid2))
        (setq endlist2 (sslength ssid2))    
        (while (< curcnt endlist2)
              (progn
        (Setq nxtcnt 1)        
        (setq tltcnt 0)
        (setq curid (ssname ssid2 0))
        (setq curnum (avalue curid "PARTNUMBER"))
            (while    (<= tltcnt endlist)
              (progn
                (setq nxtid (ssname ssid2 nxtcnt))
                (if (/= nxtid nil)              
                      (progn
                (setq nxtnum (avalue nxtid "PARTNUMBER"))
                    (if (equal curnum nxtnum)                           
                          (ssdel curid ssid2)                           
                          (setq nxtcnt (1+ nxtcnt))
                    );if end
                      );progn end
           );if end
        (setq tltcnt (1+ tltcnt))
      );progn end
    );while end
    (setq curcnt (1+ curcnt))
    (setq endlist2 (sslength ssid2))
      );progn end
      
    );while end
    )
      )

 

I know that it basically boils down to a problem with my method in filtering the set, but I have it so close I can taste it. If anyone has any suggestions on how to fix this or if they just happen to have a section of code that does this, I would be eternally grateful.

 

btw, "avalue" is a routine I have that gets an attribute out of a block. Here it is if anyone wants it..

 

; Returns the value of an attribute
(defun avalue (bname aname)
       (setq cnt 0)
       (setq ent bname)
       (while (= cnt 0)
         (setq ent (entnext ent))
         (setq entl (entget ent))
         (setq entn (cdr (assoc 2 entl)))
         (if (equal entn aname)
             (progn
              (setq cnt 1)
              (setq aval (cdr (assoc 1 entl)))
             );progn
         ); if
      ); while
); avalue

Link to comment
Share on other sites

Are you trying to filter out two attributes with the same value?

 

Could you possibly post the whole LISP so that we can see what is going on :)

 

EDIT:

 

Only reason I say this is that if we know what you are trying to achieve overall, it is sometimes easier to re-write the LISP than to try to correct an existing one. :thumbsup:

Link to comment
Share on other sites

Possible Improvement to Avalue:

 

 ; Returns the value of an attribute

(defun avalue (bname aname)
 (setq ent (entnext bname))
 (while (/= "SEQEND" (cdadr (setq elist (entget ent))))
   (if (equal (cdr (assoc 2 elist)) aname)
       (setq aval (cdr (assoc 1 elist))))
   (setq ent (entnext ent)))
) ; avalue

Link to comment
Share on other sites

Basically I have a selection set that grabs all my blocks out of the drawing. I am using that set to create a list later on in the routine. My problem is, once I have all the blocks, some are duplicates. I only need one of the blocks for each part in my list. So I am trying to filter out my set to only contain unique instances. The enitre routine is getting pretty large, so I will just post the selection set routine right now. If it isnt enough to paint a clear picture I can post the rest.

Excuse the dummy notes. They help me to learn and understand what is going on. :)

 

; The function below collects part number blocks (partid) to use in creating a schedule
; Define the Function
(defun getpart ()
;;; Sets ID selection set ("SSID") to a list and gets every entity in the drawing and filters out to only   ;;; blocks ("(cons 0 "INSERT")") and only blocks named "PARTID" ("(cons 2 "PARTID")")
 (SETQ SSID (ssget "X" (list (cons 0 "INSERT") (cons 2 "PARTID")(cons 66 1))))
 (if (= ssid nil)
   (progn
     (alert
     "\nCannot find any Item Blocks.
     \n    Check your drawing."
   );alert
     (princ);clean
     );progn end    
   (PROGN;;;Do the following.....
     (SETQ idCOUNT 0);;;Sets the counter to 0
     (setq EMAX(SSLENGTH SSID));;;Sets a "EMAX" to the length ("SSLENGTH") of the ID Selection Set ("SSID")    
     (setq ssid2 (ssadd));creates ssid2 selection set
     (setq dupss (ssadd))
     (setq curcnt 0)
     (setq fnd t)
     (WHILE (< idCOUNT EMAX);;;While the count is less that "EMAX"....
   (setq tid (ssname ssid 0))
   (ssadd tid ssid2)
   (SSDEL TID SSID)
   (SETQ idcount(1+ idcount))
     );while    
        (setq endlist (sslength ssid2))
        (setq endlist2 (sslength ssid2))    
        (while (< curcnt endlist2)
              (progn
        (Setq nxtcnt 1)        
        (setq tltcnt 0)
        (setq curid (ssname ssid2 0))
        (setq curnum (avalue curid "PARTNUMBER"))
            (while    (<= tltcnt endlist)
              (progn
                (setq nxtid (ssname ssid2 nxtcnt))
                (if (/= nxtid nil)              
                      (progn
                (setq nxtnum (avalue nxtid "PARTNUMBER"))
                    (if (equal curnum nxtnum)                           
                          (ssdel curid ssid2)                           
                          (setq nxtcnt (1+ nxtcnt))
                    );if end
                      );progn end
           );if end
        (setq tltcnt (1+ tltcnt))
      );progn end
    );while end
    (setq curcnt (1+ curcnt))
    (setq endlist2 (sslength ssid2))
      );progn end
      
    );while end
    )
      );if end
     (setq copcnt 0)
     (setq copmax (sslength ssid2))
     (WHILE (< copCNT copMAX);;;While the count is less that "EMAX"....
   (setq tid (ssname ssid2 0))
   (ssadd tid ssid)
   (SSDEL TID SSID2)
   (SETQ copcnt(1+ copcnt)))
     );progn end      
(princ);finish clean
)

Link to comment
Share on other sites

Not sure if this would work:

 

(untested - hence theoretical!)

 

(defun getpart (/ i bEnt ent elist aval attLst)
 (if (setq ssid (ssget "X" (list (cons 0 "INSERT") (cons 2 "PARTID") (cons 66 1))))
   (progn
   (setq i (sslength ssid))
   (while (not (minusp (setq i (1- i))))
     (setq bEnt (ssname ssid i)
           ent  (entnext bEnt))
     (while (/= "SEQEND" (cdadr (setq elist (entget ent))))
       (if (equal (cdr (assoc 2 elist)) "PARTNUMBER")
           (setq aval (cdr (assoc 1 elist))))
       (setq ent (entnext ent)))
     (if (member aval attLst)
         (ssdel bEnt ssid)
         (setq attLst (cons aval attLst)))))
   (alert "No Blocks Found."))
 (princ))

Link to comment
Share on other sites

hard eight

 

A bit confusing. The (cons 2 "PARTID") filter means that only 1 BLOCK name is accepted. What part of the INSERTs are duplicated? The insert point? Attribute values?

 

(ssdel) can remove an entity from a PICKSET but you need some parameters to compare. -David

Link to comment
Share on other sites

David, I assumed that multiple blocks of the same name were copied, and have different attribute values for the attribute: PARTNUMBER.

 

Hence, in my code, I shuffle through the set, and list the att values, then, if a later block has an attribute value that has already been seen, it is deleted from the set.

Link to comment
Share on other sites

Just tested my LISP using the code below:

 

See video example attached :)

 

(defun c:test (/ i2 ssid Blk attent aelist avalu tattLst)
 (vl-load-com)

 (defun getpart (/ i bEnt ent elist aval attLst)
 (if (setq ssid (ssget "X" (list (cons 0 "INSERT") (cons 2 "PARTID") (cons 66 1))))
   (progn
   (setq i (sslength ssid))
   (while (not (minusp (setq i (1- i))))
     (setq bEnt (ssname ssid i)
           ent  (entnext bEnt))
     (while (/= "SEQEND" (cdadr (setq elist (entget ent))))
       (if (equal (cdr (assoc 2 elist)) "PARTNUMBER")
           (setq aval (cdr (assoc 1 elist))))
       (setq ent (entnext ent)))
     (if (member aval attLst)
         (ssdel bEnt ssid)
         (setq attLst (cons aval attLst)))))
   (alert "No Blocks Found."))
 (princ))
 
 (getpart)
 (setq i2 (sslength ssid))
 (while (not (minusp (setq i2 (1- i2))))
   (setq Blk (ssname ssid i2)
     attent (entnext Blk))
    (while (/= "SEQEND" (cdadr (setq aelist (entget attent))))
       (if (equal (cdr (assoc 2 aelist)) "PARTNUMBER")
           (setq avalu (cdr (assoc 1 aelist))))
       (setq attent (entnext attent)))
   (setq tattLst (cons avalu tattLst)))
 (princ (vl-princ-to-string tattLst))
 (princ))

 

Hope this helps! :)

SSFilter.zip

Link to comment
Share on other sites

One more solution. Higlight and return cleaned selection set.

 

(defun c:pclean(/ blSet cStr vLst)
 (vl-load-com)
 (if(setq blSet(ssget "_X" '((0 . "INSERT")(2 . "PARTID")(66 . 1))))
   (progn
     (foreach b(mapcar 'vlax-ename->vla-object
		   (vl-remove-if 'listp(mapcar 'cadr(ssnamex blSet))))
(foreach a(vlax-safearray->list(vlax-variant-value(vla-getAttributes b)))
  (if(and(= "PARTNUMBER"(vla-get-TagString a))
       (member(setq cStr(vla-get-TextString a))vLst)
      ); end and
    (ssdel(vlax-vla-object->ename b)blSet)
    (setq vLst(cons cStr vLst))
    ); end if
  ); end foreach
); end foreach
     (cadr(sssetfirst nil blSet))
     ); end progn
   ); end if
 ); end of c:pclean

Link to comment
Share on other sites

ASMI, I think yours pretty much follows the same method as mine - except that you use VL instead.

 

Just comparing the attribute to those already accumulated in a list, and if (member) returns T, then delete from SS. :thumbsup:

Link to comment
Share on other sites

leemacs code worked wonderfully, I just don't understand it at all, lol, but I am dissecting it and learning as I go. I have pretty much finished my first routine, thanks mostly to you guys, and I will be posting it shortly where maybe someone can look at it and get some ideas for stuff they need to do. Hopefully I can end up helping someone else like I was helped.

Thanks again!

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