Code Red > AutoLISP (Vanilla / Visual)

Copy all objects to other layer

(1/2) > >>

Adesu:
Hi,
it's my code to copy all objects in layer "0" to layer "Temp", but it's still got problem, the result all objects still in layer 0.

--- Code: ---(defun c:test (/ cnt lay nlay pt ss sse ssl ssn)
  (setq nlay "TEMP")
  (setq lay (getvar "clayer"))
  (if
    (/= lay nlay)
    (command "_layer" "m" nlay "c" 7 "" "")
    )
  (setvar "clayer" "0")
  (command "_layer" "off" nlay "")
  (setq ss (ssget "x" '((8 . "0"))))
  (setq ssl (sslength ss))
  (setq cnt 0)
  (repeat
    ssl
    (setq ssn (ssname ss cnt))
    (setq sse (entget ssn))
    ;(setq etyp (cdr (assoc 0 sse)))
    (setq pt (cdr (assoc 10 sse)))
    (setvar "clayer" nlay)
    (command "_copy" ssn "" pt pt "")
    (setq cnt (1+ cnt))
    ) ; repeat
  (princ)
  )   ; defun

--- End code ---

CAB:
Do you want two of every object in the drawing or just set all objects to layer "0"?

ronjonp:
Give this a try :)

--- Code: ---(defun c:test (/ cnt lay nlay pt ss sse ssl ssn)
  (vl-load-com)
  (setq nlay "TEMP")
  (setq lay (getvar "clayer"))
  (if
    (/= lay nlay)
     (command "_layer" "m" nlay "c" 7 "" "")
  )
  (setvar "clayer" "0")
  (command "_layer" "off" nlay "")
  (setq ss (ssget "x" '((8 . "0"))))
  (setq ssl (sslength ss))
  (setq cnt 0)
  (repeat
    ssl
     (setq ssn (ssname ss cnt))
     (setq sse (entget ssn))
;(setq etyp (cdr (assoc 0 sse)))
     (setq pt (cdr (assoc 10 sse)))
     (setvar "clayer" nlay)
     (command "_copy" ssn "" pt pt "")
     (vla-put-layer (vlax-ename->vla-object (entlast)) "TEMP")
     (setq cnt (1+ cnt))
  ) ; repeat
  (princ)
) ; defun
--- End code ---

Adesu:
Hi ronjonp,
Wow......it's great...thanks.

FengK:
Not tested.

(defun c:test (/ doc colLay layName ss i obj)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        colLa (vla-get-layers doc)
        layName "Temp")
  (if (not (tblsearch "LAYER" layName))
    (vla-add colLay layName)
  )
  (if (setq ss (ssget "X" (list (cons 8 "0"))))
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq obj (vla-copy (vlax-ename->vla-object (ssname ss i))))
        (vla-put-layer obj layName)
        (setq i (1+ i))
      )
      (prompt "\nDone.")
    )
    (prompt "\nNo object on layer \"0\"".))
  (princ)
)

Navigation

[0] Message Index

[#] Next page