Jump to content

need help with foreach loop from list


aridzv

Recommended Posts

Hi.

I try to write a lisp that will loop a list of layers and join all the polylines in that layer that can be joined.

I have a lisp that do it layer by layer,

but when I tried to do it with a foreach loop I failed...

I attched here the lisp I try to write a sample dwg.

 

thanks,

aridzv.

PipesToPline1.lsp sample1.dwg

Link to comment
Share on other sites

Again so close

 

foreach means loop for each item in datalist and pass that item off as what ever variable you have after foreach. i changed it from ent to item but it could be anything.
 

(foreach item Datalist  ; item = ("P_DN25-6" 0.01)
  (if (tblsearch "LAYER" (car item)) ;Check if the layer exists
    (progn
      (setq sel1 (ssget "_X" '((8 . (car item)))))
      (command "pedit" "m" sel1 ""  "j" (cadr item) "")
    );End progn
  ) ;End if
);;end foreach

 

This is what it looks like replacing the car and cadr The way you have it.

(foreach item Datalist  ; item = ("P_DN25-6" 0.01)
  (if (tblsearch "LAYER" ("P_Laterl" 0.01))                    ;(car Datalist)
    (progn
      (setq sel1 (ssget "_X" '((8 . ("P_Laterl" 0.01)))))      ;(car Datalist)
      (command "pedit" "m" sel1 ""  "j" ("P_DN16-4" 0.01) "")  ;(cadr Datalist)
    );End progn
  ) ;End if
);;end foreach

 

Link to comment
Share on other sites

hi @mhupp and thanks for the reply!!

 

yes, it is embarrassing that I used (car Datalist) instead of (car ent)....

I run the code and I'm getting this error:

; ----- LISP : Call Stack -----
; [0]...C:PIPESTOPLINE1 <<--
;
; ----- Error around expression -----
; '((8 CAR ITEM))

 

I can't figure it out...

thanks,

aridzv.

Link to comment
Share on other sites

I don't have CAD running at the weekend of course, and ssget might be slightly different in it's filters. The error is in the line (setq sel1 (ssget "_X" '((8 . (car item))))) I reckon:

'( means a list as it is written where (list means evaluate the following list, might be that you need to use that instead?

(8 . (car item)) might need to be cons to make up that dotted pair list, which makes a list and evaluates the parts in it

Something like this might work better?

 

(setq sel1 (ssget "_X" (list (cons 8 (CAR ITEM))) ))

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

Hi @Steven P and thanks for the reply.

 

Worked like a charm - thank you!!

now,

is it possible to let the user select the lines (maybe with SSGET?) istead of the lisp do it for all the drawing?

I tried to do it but failed.

 

thanks,

aridzv.

 

Link to comment
Share on other sites

Change this :

(setq sel1 (ssget "_X" (list (cons 0 "~VIEWPORT") (cons 8 (car item)))))

To this :

(setq sel1 (ssget "_:L" (list (cons 8 (car item)))))

 

But then it's cumbersome to do (foreach loops...

So I'll still stick with :

(setq sel1 (ssget "_A" (list (cons 0 "~VIEWPORT") (cons 8 (car item)))))

which is similar to "_X", only difference is capture objects thawed in current layout, whereas "_X" captures everything frozen or thawed on Model space, or Paper space...

Edited by marko_ribar
Link to comment
Share on other sites

This is my favourite ssget reference: http://lee-mac.com/ssget.html - a lot of stuff in there (google "Lee Mac SSGET" should get you there too)

"_X" is Extended search (Entire Drawing Database) - everything

 

but you can run ssget without that:

 

(setq sel1 (ssget (list (cons 8 (CAR ITEM))) ))

 

Link to comment
Share on other sites

Your code prettier and more operational...

 

(defun C:PipesToPline1 ( / *error* cmd pea datalist sel )

  (defun *error* ( m )
    (if cmd
      (setvar 'cmdecho cmd)
    )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 1)
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq datalist ;   Layer | Fuzz factor for joining
          '(("P_Laterl" 0.01)
            ("P_DN16-4" 0.01)
            ("P_DN16-6" 0.01)
            ("P_DN20-4" 0.01)
            ("P_DN25-4" 0.01)
            ("P_DN25-6" 0.01)
            ("P_DN32-4" 0.01)
            ("P_DN32-6" 0.01)
            ("P_DN32-8" 0.01)
            ("P_DN40-4" 0.01)
            ("P_DN40-6" 0.01)
            ("P_DN40-8" 0.01)
            ("P_DN50-6" 0.01)
            ("P_DN50-8" 0.01)
            ("P_DN50-10" 0.01)
            ("P_DN63-6" 0.01)
            ("P_DN63-8" 0.01)
            ("P_DN63-10" 0.01)
            ("P_DN75-6" 0.01)
            ("P_DN75-8" 0.01)
            ("P_DN75-10" 0.01)
            ("P_DN75-12.5" 0.01)
            ("P_DN90-6" 0.01)
            ("P_DN90-8" 0.01)
            ("P_DN90-10" 0.01)
            ("P_DN110-6" 0.01)
            ("P_DN110-8" 0.01)
            ("P_DN110-10" 0.01)
            ("P_DN110-12.5" 0.01)
            ("P_DN125-6" 0.01)
            ("P_DN140-6" 0.01)
            ("P_DN140-8" 0.01)
            ("P_DN140-10" 0.01)
            ("P_DN160-6" 0.01)
            ("P_DN160-8" 0.01)
            ("P_DN160-10" 0.01)
            ("P_DN160-12.5" 0.01)
            ("P_DN200-6" 0.01)
            ("P_DN225-6" 0.01)
            ("P_DN225-8" 0.01)
            ("P_DN225-10" 0.01)
            ("P_DN225-12.5" 0.01)
            ("P_DN250-6" 0.01)
            ("P_DN250-12.5" 0.01)
            ("P_DN280-6" 0.01)
            ("P_DN280-8" 0.01)
            ("P_DN280-10" 0.01)
            ("P_DN280-12.5" 0.01)
            ("P_DN315-6" 0.01)
            ("P_DN315-8" 0.01)
            ("P_DN315-10" 0.01)
            ("P_DN315-12.5" 0.01)
            ("P_DN355-6" 0.01)
            ("P_DN450-6" 0.01)
           )
  )

  (foreach ent datalist
    (if (tblsearch "LAYER" (car ent)) ;Check if the layer exists
      (progn 
        (setq sel (ssget "_A" (list (cons 0 "~VIEWPORT") (cons 8 (car ent)))))
        (command "_.pedit" "_m" sel "" "_j" (cadr ent))
        (while (< 0 (getvar 'cmdactive))
          (command "")
        );End while
      );End progn
    );End if
  );End foreach
  (*error* nil)
)

 

I've added error handler as it's better to have it written, then to let function exit with left variables unlocalized...

Edited by marko_ribar
Link to comment
Share on other sites

what I thought @aridzv was asking for is to run this code against only a per defined selection set. not pick all entities. is that what the (while (< 0 (getvar 'cmdactive)) is doing?

 

(defun C:PipesToPline1 (/ *error* cmd pea lay layers ss sel ss2)
  (defun *error* (m)
    (if cmd (setvar 'cmdecho cmd))
    (if pea (setvar 'peditaccept pea))
    (if m (prompt m))
    (princ)
  )
  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 1)
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  ;simplifed the list and added 0.1 to the command.
  (setq layers '("P_Laterl" "P_DN16-4" "P_DN16-6" "P_DN20-4" "P_DN25-4" "P_DN25-6" "P_DN32-4"
                 "P_DN32-6" "P_DN32-8" "P_DN40-4" "P_DN40-6" "P_DN40-8" "P_DN50-6" "P_DN50-8"
                 "P_DN50-10" "P_DN63-6" "P_DN63-8" "P_DN63-10" "P_DN75-6" "P_DN75-8" "P_DN75-10"
                 "P_DN75-12.5" "P_DN90-6" "P_DN90-8" "P_DN90-10" "P_DN110-6" "P_DN110-8" "P_DN110-10"
                 "P_DN110-12.5" "P_DN125-6" "P_DN140-6" "P_DN140-8" "P_DN140-10" "P_DN160-6" "P_DN160-8"
                 "P_DN160-10" "P_DN160-12.5" "P_DN200-6" "P_DN225-6" "P_DN225-8" "P_DN225-10" "P_DN225-12.5"
                 "P_DN250-6" "P_DN250-12.5" "P_DN280-6" "P_DN280-8" "P_DN280-10" "P_DN280-12.5" "P_DN315-6"
                 "P_DN315-8" "P_DN315-10" "P_DN315-12.5" "P_DN355-6" "P_DN450-6")
  )
  (setq ss (ssget '((0 . "*LINE")))) ;main selection you will be testing against. add other entites types 
  (foreach lay layers
    (if (tblsearch "LAYER" lay)
      (progn
        (setq ss2 (ssadd))
        (if (setq sel (ssget "_X" (list (cons 410 (getvar 'CTAB)) (cons 8 lay))))
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
            (if (ssmemb ent ss) ;check to see if any of the ssget "_X" selection is inside the main selection ss
              (progn
                (ssadd ent ss2) ;if it is add to selection set ss2
                (ssdel ent ss) ;remove it from the main seleciton ss
              )
            )
          )
        )
        (if (> (sslength ss2) 1)
          (progn
            (command "_.pedit" "_m" ss2 "" "_j" 0.1)
            (while (< 0 (getvar 'cmdactive))
              (command "")
            );End while
            (setq ss2 nil)
          )
        )
      )  ;End progn
    )    ;End if
  )      ;End foreach
  (*error* nil)
  (princ)
)

 

Edited by mhupp
  • Like 1
Link to comment
Share on other sites

(while (< 0 (getvar 'cmdactive))

  (command "")

)

 

was put after PEDIT command and is just makking sure that after known tokens PEDIT command exit with only needed "" - ENTER times ... - while cmdactive, then routine continues to next statement(s)...

  • Like 1
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...