Hardeight Posted January 22, 2009 Share Posted January 22, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 22, 2009 Share Posted January 22, 2009 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 22, 2009 Share Posted January 22, 2009 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 Quote Link to comment Share on other sites More sharing options...
Hardeight Posted January 22, 2009 Author Share Posted January 22, 2009 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 ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 22, 2009 Share Posted January 22, 2009 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)) Quote Link to comment Share on other sites More sharing options...
David Bethel Posted January 22, 2009 Share Posted January 22, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 22, 2009 Share Posted January 22, 2009 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 22, 2009 Share Posted January 22, 2009 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 23, 2009 Share Posted January 23, 2009 Just a thought to get rid of multiples sort the list then just check what is next if the same skip and keep going goes through list once. Quote Link to comment Share on other sites More sharing options...
ASMI Posted January 23, 2009 Share Posted January 23, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 23, 2009 Share Posted January 23, 2009 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. Quote Link to comment Share on other sites More sharing options...
Hardeight Posted January 27, 2009 Author Share Posted January 27, 2009 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! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 27, 2009 Share Posted January 27, 2009 I can run through my code with you if you want HardEight, commenting each line Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.