copy layer and sort, sometime duble copy

this code is for detailing by layer name the layer must all open/show, user select the all layer and give the place point, my problem with this code is, the layer is not sort by number (my layer is 01 02 03 04 and so on) and sometime double copy with same layer name. any solution pls tq

 (defun dtr (a)   (* pi (/ a 180.0)) )
(defun c:detlay    ()   (setq ppt1 (getpoint "\nPlace:"))
(setq ssob (ssget))
(setq ii 0)
(setq dwqty 0)
(while 
(setq obnum (cdr (assoc 8 (entget (ssname ssob ii)))))
(setq lyr (tblsearch "LAYER" obnum)) 
(setq lnm (cdr (assoc 2 lyr))) 
(setq sellay (ssget "_X" (list (cons 8 obnum))))
(command    "_copy" sellay "" (polar ppt1 (dtr 270.0) dwqty)"")
(setq ii (1+ ii))
(setq dwqty (+ dwqty 50))     )   )

First of all. wrap your code using the button -> #

(read Sticky Thread: posting guidelines)

as it stands now:

 (setq obnum (cdr (assoc 8 (entget (ssname ssob ii)))))

This will generate an error as this line will not issue a nil value for the while function.

better to use

  (repeat (sslength ssob) (setq obnum....

This line is irrelevant

(setq lyr (tblsearch "LAYER" obnum))
(setq lnm (cdr (assoc 2 lyr)))

Also make it a point localize your variable

 (defun c:detlay (/ ppt1 ssob ii dwqty )

and since you're only going to use this oince

 (defun dtr (a) (* pi (/ a 180.0)) )

 (command "_copy" sellay "" (polar ppt1 (dtr 270.0) dwqty)"")<--- always 270

 
[color=#000000](defun c:detlay[color=blue] (/ ppt1 ssob ii dwqty )[/color]
(setq ppt1 (getpoint "\nPlace:"))
 (setq ssob (ssget))
 (setq ii 0)
 (setq dwqty 0)
 [color=blue](repeat (sslength ssob)[/color] (setq obnum (cdr (assoc 8 (entget (ssname ssob ii)))))
    (setq sellay (ssget "_X" (list (cons 8 obnum))))
   (command "_copy" sellay "" (polar ppt1[color=blue] (* pi (/ 270 180.0))[/color] dwqty)"")
   (setq ii (1+ ii)) (setq dwqty (+ dwqty 50))
   )
 )[/color]

and lastly. I dont quite understand the question

And welcome to the forum

the code you re-create it's was no error but the result is still same

with my old code, the selected object copy repeated with same layer name

i dont want like that, what i want only 1 time copy and place it to new location

let say: i have 3 different layer all opened with same place (overlap)

i want to copy each layer to other place with distance (setq dwqty (+ dwqty 50)) each other

so user can see the object of layer without crossing object with all layer

First of all. wrap your code using the button -> #

(read Sticky Thread: posting guidelines)

 

as it stands now:

 (setq obnum (cdr (assoc 8 (entget (ssname ssob ii)))))

This will generate an error as this line will not issue a nil value for the while function.

 

better to use

  (repeat (sslength ssob) (setq obnum....

This line is irrelevant

(setq lyr (tblsearch "LAYER" obnum))
(setq lnm (cdr (assoc 2 lyr)))

Also make it a point localize your variable

 

 (defun c:detlay (/ ppt1 ssob ii dwqty )

and since you're only going to use this oince

 (defun dtr (a) (* pi (/ a 180.0)) )

 (command "_copy" sellay "" (polar ppt1 (dtr 270.0) dwqty)"")<--- always 270

 
[color=#000000](defun c:detlay[color=blue] (/ ppt1 ssob ii dwqty )[/color]
(setq ppt1 (getpoint "\nPlace:"))
 (setq ssob (ssget))
 (setq ii 0)
 (setq dwqty 0)
 [color=blue](repeat (sslength ssob)[/color] (setq obnum (cdr (assoc 8 (entget (ssname ssob ii)))))
    (setq sellay (ssget "_X" (list (cons 8 obnum))))
   (command "_copy" sellay "" (polar ppt1[color=blue] (* pi (/ 270 180.0))[/color] dwqty)"")
   (setq ii (1+ ii)) (setq dwqty (+ dwqty 50))
   )
 )[/color]

and lastly. I dont quite understand the question

 

And welcome to the forum

the code you re-create it's was no error but the result is still same....

Well. i suggest you look at it again and i meant it to do the same thing as i dont know yet what you wanted in the first place

with my old code, the selected object copy repeated with same layer name i dont want like that, what i want only 1 time copy and place it to new location

 

let say: i have 3 different layer all opened with same place (overlap)

i want to copy each layer to other place with distance (setq dwqty (+ dwqty 50)) each other

so user can see the object of layer without crossing object with all layer

I see, so copy the layer to another location: 3 overlapping entities, different layers, make a copy of the 1st of 3 layers and place it at a given angle and distance after that the 2nd of 3 layers at the same angle and twice the distance as the 1st one, and so on. but limited only to the selected objects? is this correct?

selected by user only

selected by user only

okidoki,

to clarify, make a copy and not move? (sort of separate)

okidoki,

to clarify, make a copy and not move? (sort of separate)

user will make selection of object than coding will separate the each layer and copy layer to other place input by user

and repeat next layer till the layer finish

user will make selection of object than coding will separate the each layer and copy layer to other place input by user

and repeat next layer till the layer finish

Not sure if this is want you want

try this one for now

 
(defun c:test(/ ppt1 ssob lys dwqty )
(setvar 'cmdecho 0)  
(setq ppt1 (getpoint "\nPlace:"))
 (setq ssob (ssget))
 (setq dwqty 0)
(mapcar
(function (lambda (j / k)
          (if (not 
             (member (setq k (cdr (assoc 8 (entget j)))) lys))
             (setq lys (cons k lys)))
            ))
 (vl-remove-if 'listp
          (mapcar 'cadr (ssnamex ssob)))
 )
 (foreach ln lys
    (sssetfirst nil ssob)
    (setq sellay (ssget "_p" (list (cons 8 ln))))
     (command "_copy" sellay "" "" "_none" ppt1
                 (polar ppt1 (* pi (/ 45 180.0)) (setq dwqty (+ 50 dwqty)))
     )
   )
 )

I'm trying as much as possible not to deviate from your original code

got error!

Point or option keyword required.
; error: Function cancelled
Specify base point or displacement, or [Multiple]: *Cancel*

got error!

 

Point or option keyword required.
; error: Function cancelled
Specify base point or displacement, or [Multiple]: *Cancel*

hmmmn wonder why.. thats the reason as much as possible i try to avoid using command functions

any other error message?

give me a minute, i think i'll just re-write everything..

try this (for now)

(defun c:test (/ adoc ppt1 ssob dwqty lys)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(setq ssob (ssget) dwqty 0)
(mapcar
(function
(lambda (j / k)
(if (not (member (setq k (cdr (assoc 8 (entget j)))) lys))
(setq lys (cons k lys)))))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ssob))))
(foreach ln lys
(sssetfirst nil ssob)
(setq sellay (ssget "_p" (list (cons 8 ln))))
(vlax-for ob (vla-get-activeselectionset adoc)
(vla-move (vla-copy ob) (vlax-3d-point (setq ppt1 '(0.0 0.0)))
(vlax-3d-point (polar ppt1[color=blue] 0.785398[/color] (setq dwqty (+ 50 dwqty)))))[color=blue];<--- 45 degress [/color]
)
)
(sssetfirst nil)
(princ)
)

This might be in need of change ..

(* pi (/ 270. 180.0))

i guess you're right

but as much as possible I dont want to deviate from his orignal code thats why it sticks and I still dont fully undertand the prurpose of his routine.

but good call neverthelss TharwaT

That what I felt of in the beginning of the thread.

But now I guess that he wants to repeat the selected objects according to the quantity of Layers that are

existed within the selection set and not to be repeat two or three times if many objects are laying within the same Layer Name.

Hope that my guess is right although .

Hope that my guess is right although .

We shall see......

I'm guessing as well

I think his problem is in his first ssget selection, he's selecting objects on multiple layers. The first time for each layer is fine, but if it's repeated, all hell breaks loose.

Is this what you are after?

(defun c:TEst (/ q ss pt i layer lst)
 (if (and (setq q  -50.
                ss (ssget "_:L")
          )
          (setq pt (getpoint "\nSpecify base point: "))
     )
   (repeat (setq i (sslength ss))
     (if (not (member (setq layer (cdr (assoc 8 (entget (ssname ss (setq i (1- i))))))) lst))
       (progn (setq lst (cons layer lst))
              (command "_.copy"
                       [color=red](ssget "_X" (list (cons 8 layer) (cons 410 (getvar 'ctab))))[/color] ;TERRIBLE METHOD!!!
                       ""
                       "_non"
                       (polar pt (* 1.5 pi) (setq q (+ q 50.)))
                       ""
              )
       )
     )
   )
 )
 (princ)
)

I'd probably write it like this:

(defun c:test ( / _move d ss l lst ) (vl-load-com)

 (defun _move ( obj dist )
   (vla-move (vla-copy obj) (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point (list 0. dist 0.)))
 )

 (if (ssget "_:L")
   (progn
     (vlax-for obj (setq d 0. ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
       (_move obj
         (cond
           ( (cdr (assoc (setq l (vla-get-layer obj)) lst)) )
           ( (setq lst (cons (cons l (setq d (- d 50.))) lst)) d )
         )
       )
     )
     (vla-delete ss)
   )
 )
 (princ)
)

I'd probably write it like this:

 

(defun c:test ( / _move d ss l lst ) (vl-load-com)

 (defun _move ( obj dist )
   (vla-move (vla-copy obj) (vlax-3D-point '(0. 0. 0.)) (vlax-3D-point (list 0. dist 0.)))
 )

 (if (ssget "_:L")
   (progn
     (vlax-for obj (setq d 0. ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
       (_move obj
         (cond
           ( (cdr (assoc (setq l (vla-get-layer obj)) lst)) )
           ( (setq lst (cons (cons l (setq d (- d 50.))) lst)) d )
         )
       )
     )
     (vla-delete ss)
   )
 )
 (princ)
)

This is why one shouldn't code when they are coming down with the flu. Nice work Lee. I am curious, won't _move error the first time for each layer, since your cond will return nil, or is my sickness missing something.....I'm going home.

This is why one shouldn't code when they are coming down with the flu. Nice work Lee. I am curious, won't _move error the first time for each layer, since your cond will return nil, or is my sickness missing something.....I'm going home.

Cheers dude

The cond will never return nil, since the second condition just constructs the list and returns the distance.

Hope you get better soon mate

Cheers dude

 

The cond will never return nil, since the second condition just constructs the list and returns the distance.

 

Hope you get better soon mate

Yeah, I was standing in front of the urinal and realized what you must have done.

Thanks.