Jump to content

Loop through layer names from selected objects


5 Aces Down

Recommended Posts

Hi,

 

 

I,m new in this Autolisp world. I wonder if somebody can help me on a project of mine. I have an AutoCAD project which has layers stacked over each other.

I'm looking for lisp codes that will loop through layer names from selected objects and separate those objects (layers) and place them side by side at 35in apart.

 

 

Any help will be welcome.

 

 

Thanks.

Link to comment
Share on other sites

This should give you a start:

(defun C:test ( / i cmd ld ln Layers SS SSS n )
 (initget (+ 1 2))
 (if (setq i (getint "\nSpecify spacing increment: "))
   (progn
     (setq cmd (getvar 'cmdecho))
     (setvar 'cmdecho 0)
     (while (setq ld (tblnext "LAYER" (not ld)))
       (and
         (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (setq ln (cdr (assoc 2 ld)))))))))
         (setq Layers (cons ln Layers))
       ); and
     ); while
     (foreach x Layers
       (setq SS (ssget "_X" (list (cons 8 x))))
       (setq SSS (cons SS SSS))
     )
     (foreach s SSS
       (command "_.MOVE" s "" "_non" '(0. 0. 0.) "_non" (list 0. (setq n (cond (n (+ n i)) (0))) 0.))
     )
     (and cmd (setvar 'cmdecho cmd))
   ); progn
 ); if
 (princ)
); defun

We don't use imperial system, sorry.

Link to comment
Share on other sites

Its kind of an odd request.

  • Do you want all of the layer entities spread out across the X axis ?
  • What if the bounding box is larger than space increments ?
  • What if the entities are actually nested ?

 

 

 

Grrr :

 

I would think that these are the same ?

 

(/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (setq ln (cdr (assoc 2 ld)))))))))

(/= 4 (logand 4 (cdr (assoc 70 ld))))

 

-David

Link to comment
Share on other sites

Grrr :

 

I would think that these are the same ?

 

(/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (setq ln (cdr (assoc 2 ld)))))))))

(/= 4 (logand 4 (cdr (assoc 70 ld))))

 

-David

 

Yes, I went that way "just in case". Post #12 & #13 from this thread.

Did not remember this important fragment from LM's message:

cannot be used to modify the layer properties.

 

Thanks for refreshing my memory!

Link to comment
Share on other sites

Thanks a lot for your help. It is an odd request on my part.

In AutoCAD, several layers for silk printed circuits are stacked (silver ink, carbon ink, dielectric ink...).

The idea is then to have those layers spread along the X axis so they can individually be selected and transfered to production.

The bounding box (frame) is the same size as the space increment along the X axis. Entities are not nested.

 

 

David Bethel did a great job in supplying codes in 15 minutes, wow! His codes separates layers whether they are ON or OFF.

I would like for only selected layers to be spread along the X axis. Also, one of those layers need to be copied along the increments:

I explain, say I have layers 'silver', 'carbon', dielectric' and 'frame'. The first three layers would be spreaded along the X axis and layer 'frame' would be copied with each of those layers.

 

 

Thanks again for your help guys.

Link to comment
Share on other sites

; Spacing selection set by layer
(defun C:test ( / lnm SS b L p acDoc Lyrs ln d ln ll ur pl )
 (setq lnm "frame") ; <- Adjust the layer name here, to copy along the spacing
 (cond
   ( (not (and (setq SS (ssget "_:L-I")) (princ "\nSelect objects to space by their layer: ")))
     (princ "\nNothing selected.")
   )
   (
     (not
       (progn
         (vlax-for o (setq SS (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
           (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list o 'll 'ur))))
             (setq b (append b (mapcar 'vlax-safearray->list (list ll ur))))
           )
           (setq L (cons (list (vla-get-Layer o) o) L))
         ); vlax-for
         (vla-Delete SS)
         (and
           (or
             (and b (setq b (mapcar '(lambda (a b) (/ (+ a b) 2.)) (apply 'mapcar (cons 'min b)) (apply 'mapcar (cons 'max b)))))
             (setq b (getpoint "\nSpecify base point: "))
           )
           (setq p (getpoint b "\nSpecify direction and spacing: "))
         )
       ); progn
     ); not
     (princ "\nSpacing not specified.")
   )
   (p
     (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)
     (mapcar '(lambda (x) (cond ((member x Lyrs)) ((setq Lyrs (cons x Lyrs))))) (mapcar 'car L))
     (
       (lambda ( x )
         (and acDoc (tblsearch "LAYER" x) (member lnm Lyrs) (eq (vla-get-Lock (vla-item (vla-get-Layers acDoc) x)) :vlax-false) (setq ln x) )
       )
       lnm
     )  
     (mapcar 
       '(lambda (x) 
         (cond
           (d (setq d (+ d (distance b p))) )
           ( (setq d (distance b p)) )
         )
         (mapcar 
           '(lambda (o)
             (if (= x (car o))
               (progn
                 (apply 'vla-Move (append (list (cadr o)) (setq pl (mapcar 'vlax-3D-point (list '(0. 0. 0.) (polar '(0. 0. 0.) (angle b p) d))))))
                 (if ln (mapcar '(lambda (fr / c) (if (= (car fr) ln) (progn (setq c (vla-Copy (cadr fr))) (apply 'vla-Move (append (list c) pl))))) L))
               )
             )
           ) 
           L
         )
       ) 
       (vl-remove ln (acad_strlsort Lyrs))
     )
     (vla-EndUndoMark acDoc) 
   )
 ); cond
 (princ)
); defun    
(vl-load-com) (princ)     

Edited by Grrr
Link to comment
Share on other sites

Oups! My bad, sorry Grrr, you're the one with all the codes. I tested your last post and the codes work great, thanks!

I know I'm asking a lot, but is there a way of copying a layer (let's call it 'frame') over each other layers?

The final result would be for all the layers to be spread along the X axis (as your codes does) and each would have a copy of the same 'frame' layer with it.

In real life, that frame represents the printing silk size with the separated layers (circuit printing inks) inside each of those frames.

 

 

Thanks again Grrr, I beleive you saved me a few years of work!

Link to comment
Share on other sites

I know I'm asking a lot, but is there a way of copying a layer (let's call it 'frame') over each other layers?

The final result would be for all the layers to be spread along the X axis (as your codes does) and each would have a copy of the same 'frame' layer with it.

I've modified the code in post #6, Adjust your layer name here:

(setq lnm "frame") ; <- Adjust the layer name here, to copy along the spacing

If there are objects on that layer within the selection, they will be copied along the others, otherwise the result will be "only spacing by layer".

Link to comment
Share on other sites

The codes work perfectly, thanks a million Grrr!

I can't beleive it was done in 24hrs. I'm glad I joined this forum.

 

No problem, I'm trying my best on learning from guys like Lee Mac and Tharwat - without them you wouldn't see that code posted from me, but I'm sure they'd help you instead.

Link to comment
Share on other sites

Hi Grrr,

 

 

I'm trying to modify your codes to add a second layer to be copied along with the increment.

The layer 'frame' already is, so I added layer 'marks' to act the same (see lines 3 and 4).

I changed codes where hilighted in yellow. And I get the 'too many arguments' error. Where did I go wrong?

 

 

Thanks,

 

 

; Spacing selection set by layer

(defun C:test2 ( / lnm lnm2 SS b L p acDoc Lyrs Lyrs2 ln d ln ll ur pl )

(setq lnm "frame") ;

(setq lnm2 "marks")

(cond

( (not (and (setq SS (ssget "_:L-I")) (princ "\nSelect objects to space by their layer: ")))

(princ "\nNothing selected.")

)

(

(not

(progn

(vlax-for o (setq SS (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))

(if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-GetBoundingBox (list o 'll 'ur))))

(setq b (append b (mapcar 'vlax-safearray->list (list ll ur))))

)

(setq L (cons (list (vla-get-Layer o) o) L))

); vlax-for

(vla-Delete SS)

(and

(or

(and b (setq b (mapcar '(lambda (a b) (/ (+ a b) 2.)) (apply 'mapcar (cons 'min b)) (apply 'mapcar (cons 'max b)))))

(setq b (getpoint "\nSpecify base point: "))

)

(setq p (getpoint b "\nSpecify direction and spacing: "))

)

); progn

); not

(princ "\nSpacing not specified.")

)

(p

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

(vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)

(mapcar '(lambda (x y) (cond ((member x Lyrs y Lyrs2)) ((setq Lyrs (cons x Lyrs) setq Lyrs2 (cons y Lyrs2))))) (mapcar 'car L))

(

(lambda ( x y )

(and acDoc (tblsearch "LAYER" x y) (member lnm Lyrs lnm2 Lyrs2) (eq (vla-get-Lock (vla-item (vla-get-Layers acDoc) x y)) :vlax-false) (setq ln x y) )

)

lnm lnm2

)

(mapcar

'(lambda (x y)

(cond

(d (setq d (+ d (distance b p))) )

( (setq d (distance b p)) )

)

(mapcar

'(lambda (o)

(if (= x (car o))

(progn

(apply 'vla-Move (append (list (cadr o)) (setq pl (mapcar 'vlax-3D-point (list '(0. 0. 0.) (polar '(0. 0. 0.) (angle b p) d))))))

(if ln (mapcar '(lambda (fr / c) (if (= (car fr) ln) (progn (setq c (vla-Copy (cadr fr))) (apply 'vla-Move (append (list c) pl))))) L))

)

)

)

L

)

)

(vl-remove ln (acad_strlsort Lyrs))

)

(vla-EndUndoMark acDoc)

)

); cond

(princ)

); defun

(vl-load-com) (princ)

 

 

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