Jump to content

Move entities from 0 Layer

leos98

By leos98
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

leos98 Explorer

leos98

Posted
Posted

Hello,

We have the following problem when setting xrefs, some architects leave stuff in the "0" layer and this should be a NO NO. I am looking for a LISP that would create a new layer named "0-From0" with the same properties of the 0"" layer and then move everything in the 0"" layer to new newly created "0-From0". I found this in helengorina.com but haven't been able to get it work. Unfortunately my experience with LISP is very little and haven't been able to debug it my self.

 

(defun c:ZERO ()

(setq ssl0 (ssget “x” ‘((8 . “0"))))

(COMMAND “-layer” “N” “from0" “”)

(COMMAND “chprop” ssl0 “” “la” “from0" “”)

)

 

 

Thanks!

 

Leos98

Lee Mac Grand Master

Lee Mac

Posted
Posted

Thought I might try it in VL, but can't seem to get this to work - not sure why, and its driving me up the wall... :P

 

(defun c:0to0  (/ ss layers 0lay 0Nlay err)
 (if (setq ss (ssget "X" '((8 . "0"))))
   (progn
     (setq layers (vla-get-layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object))))
     (vlax-for    lay  layers
   (cond ((eq "0" (vla-get-name lay))
          (setq 0lay lay))
         ((eq "0-From0" (vla-get-name lay))
          (setq 0Nlay lay))))
     (if (not 0Nlay)
   (setq 0Nlay (vla-add layers "0-From0")))
     (vla-put-color 0Nlay (vla-get-color 0lay))
     (vla-put-linetype 0Nlay (vla-get-linetype 0lay))
     (vla-put-lineweight 0Nlay (vla-get-lineweight 0lay))
     (if (vl-catch-all-error-p
       (setq err (vl-catch-all-apply
           '(lambda (x) (vla-put-layer x "0-From0"))
           (mapcar    'vlax-ename->vla-object
               (mapcar 'cadr (ssnamex ss))))))
   (princ (strcat "\nError: " (vl-catch-all-error-message err)))))
   (princ "\n<!> No Objects Found on Layer \"0\" <!>"))
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted

Well, this should get you through, but I'd be interested if anyone could offer some insight into the error in the above code ^^

 

(defun c:0to0  (/ ss layers 0lay 0Nlay)
 (if (setq ss (ssget "X" '((8 . "0"))))
   (progn
     (setq layers (vla-get-layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object))))
     (vlax-for    lay  layers
   (cond ((eq "0" (vla-get-name lay))
          (setq 0lay lay))
         ((eq "0-From0" (vla-get-name lay))
          (setq 0Nlay lay))))
     (if (not 0Nlay)
   (setq 0Nlay (vla-add layers "0-From0")))
     (vla-put-color 0Nlay (vla-get-color 0lay))
     (vla-put-linetype 0Nlay (vla-get-linetype 0lay))
     (vla-put-lineweight 0Nlay (vla-get-lineweight 0lay))
     (mapcar '(lambda (x) (vla-put-layer x "0-From0"))
         (mapcar 'vlax-ename->vla-object
             (mapcar 'cadr (ssnamex ss)))))
   (princ "\n<!> No Objects Found on Layer \"0\" <!>"))
 (princ))

architecture68-raff Explorer

architecture68-raff

Posted
Posted
Hello,

I found this in helengorina.com but haven't been able to get it work. Unfortunately my experience with LISP is very little and haven't been able to debug it my self.

 

(defun c:ZERO ()

(setq ssl0 (ssget “x” ‘((8 . “0"))))

(COMMAND “-layer” “N” “from0" “”)

(COMMAND “chprop” ssl0 “” “la” “from0" “”)

)

 

Leos98

 

When I copied and pasted your code into the Visual LISP editor, the quotation marks were not of the normal style. Try copying and pasting the following code and it should work correctly. It functions OK for me now.

 

(defun c:ZERO ()
 (setq ssl0 (ssget "X" '((8 . "0"))))
 (COMMAND "-layer" "N" "from0" "")
 (COMMAND "chprop" ssl0 "" "la" "from0" "")
)

Lee Mac Grand Master

Lee Mac

Posted
Posted
When I copied and pasted your code into the Visual LISP editor, the quotation marks were not of the normal style. Try copying and pasting the following code and it should work correctly. It functions OK for me now.

 

(defun c:ZERO ()
 (setq ssl0 (ssget "X" '((8 . "0"))))
 (COMMAND "-layer" "N" "from0" "")
 (COMMAND "chprop" ssl0 "" "la" "from0" "")
)

 

It will function correctly, but the newly created layer "from0" will not be formatted the same as the original layer 0.

architecture68-raff Explorer

architecture68-raff

Posted
Posted
It will function correctly, but the newly created layer "from0" will not be formatted the same as the original layer 0.

 

Oops. Forgot that requirement.

 

Maybe this link will help you guys out with the visual lisp.

http://www.autocode.com/lisp/layerswap.htm

leos98 Explorer

leos98

Posted
  • Author
Posted

Thanks for your help guys,

 

Lee Mac I'm getting this error when I tried your code:

 

; error: no function definition: VLAX-GET-ACAD-OBJECT

 

Leos98

 

Well, this should get you through, but I'd be interested if anyone could offer some insight into the error in the above code ^^

 

(defun c:0to0  (/ ss layers 0lay 0Nlay)
 (if (setq ss (ssget "X" '((8 . "0"))))
   (progn
     (setq layers (vla-get-layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object))))
     (vlax-for    lay  layers
   (cond ((eq "0" (vla-get-name lay))
          (setq 0lay lay))
         ((eq "0-From0" (vla-get-name lay))
          (setq 0Nlay lay))))
     (if (not 0Nlay)
   (setq 0Nlay (vla-add layers "0-From0")))
     (vla-put-color 0Nlay (vla-get-color 0lay))
     (vla-put-linetype 0Nlay (vla-get-linetype 0lay))
     (vla-put-lineweight 0Nlay (vla-get-lineweight 0lay))
     (mapcar '(lambda (x) (vla-put-layer x "0-From0"))
         (mapcar 'vlax-ename->vla-object
             (mapcar 'cadr (ssnamex ss)))))
   (princ "\n<!> No Objects Found on Layer \"0\" <!>"))
 (princ))

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ahh sorry dude, forgot the good old (vl-load-com) - I have it in ACADDOC.lsp, so don't notice if its missed :(

 

(defun c:0to0  (/ ss layers 0lay 0Nlay)
 (vl-load-com)
 (if (setq ss (ssget "X" '((8 . "0"))))
   (progn
     (setq layers (vla-get-layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object))))
     (vlax-for    lay  layers
   (cond ((eq "0" (vla-get-name lay))
          (setq 0lay lay))
         ((eq "0-From0" (vla-get-name lay))
          (setq 0Nlay lay))))
     (if (not 0Nlay)
   (setq 0Nlay (vla-add layers "0-From0")))
     (vla-put-color 0Nlay (vla-get-color 0lay))
     (vla-put-linetype 0Nlay (vla-get-linetype 0lay))
     (vla-put-lineweight 0Nlay (vla-get-lineweight 0lay))
     (mapcar '(lambda (x) (vla-put-layer x "0-From0"))
         (mapcar 'vlax-ename->vla-object
             (mapcar 'cadr (ssnamex ss)))))
   (princ "\n<!> No Objects Found on Layer \"0\" <!>"))
 (princ))

David Bethel Grand Master

David Bethel

Posted
Posted

You can try this:

[b][color=BLACK]([/color][/b]defun c:zero [b][color=FUCHSIA]([/color][/b]/ nl td ss[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq nl [color=#2f4f4f]"0-From0"[/color]
       td [b][color=NAVY]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] [color=#2f4f4f]"0"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]not [b][color=MAROON]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] nl[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_New"[/color] nl[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_Color"[/color] [b][color=NAVY]([/color][/b]abs [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 62 td[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] nl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_LType"[/color] [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 6 td[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] nl[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]""[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]8 . [color=#2f4f4f]"0"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_LAyer"[/color] nl [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

leos98 Explorer

leos98

Posted
  • Author
Posted

Thanks for all of your great responses, You guys are amazing!!

I wish I knew how to program LSIP like you guys, can you point to some sites or places where I can learn?

 

Thanks again!

 

Leos98

Lee Mac Grand Master

Lee Mac

Posted
Posted
Thanks for all of your great responses, You guys are amazing!!

I wish I knew how to program LSIP like you guys, can you point to some sites or places where I can learn?

 

Thanks again!

 

Leos98

 

There are tons of sites that offer help in LISP writing - demonstrating just how popular LISP is.

 

heres a few of my suggestions:

 

AfraLISP

 

JefferySanders

RonLeigh

 

ABC's of AutoLISP

 

and a few references:

 

System Variables

 

Entity References

System Variable Alterations

Lee Mac Grand Master

Lee Mac

Posted
Posted

As requested :)

 

(defun c:0to0  (/ ss layers 0lay 0Nlay)
 (if (setq ss (ssget "X" '((8 . "0"))))
   (progn
     (setq layers (vla-get-layers
            (vla-get-ActiveDocument
              (vlax-get-acad-object))))
     (vlax-for    lay  layers
   (cond ((eq "0" (vla-get-name lay))
          (setq 0lay lay))
         ((eq "0-From0" (vla-get-name lay))
          (setq 0Nlay lay))))
     (if (not 0Nlay)
   (setq 0Nlay (vla-add layers "0-From0")))
     (vla-put-lock 0lay :vlax-false)
     (vla-put-color 0Nlay (vla-get-color 0lay))
     (vla-put-linetype 0Nlay (vla-get-linetype 0lay))
     (vla-put-lineweight 0Nlay (vla-get-lineweight 0lay))
     (mapcar '(lambda (x) (vla-put-layer x "0-From0"))
         (mapcar 'vlax-ename->vla-object
             (mapcar 'cadr (ssnamex ss))))
     (princ (strcat "\n" (rtos (sslength ss) 2 0) " Objects Moved.")))
   (princ "\n<!> No Objects Found on Layer \"0\" <!>"))
 (princ))

 

If you have any queries about the code, or on anything else, just ask :)

 

Cheers

 

Lee

leos98 Explorer

leos98

Posted
  • Author
Posted

Lee,

Do I need (vl-load-com) anywhere in the code, or not anymore.

 

Thanks!

Lee Mac Grand Master

Lee Mac

Posted
Posted

Sorry, yes you do :oops: (I always seem to forget it!)...

 

[b][color=BLACK]([/color][/b]defun c:0to0  [b][color=FUCHSIA]([/color][/b]/ ss layers 0lay 0Nlay[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]vl-load-com[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]8 . [color=#2f4f4f]"0"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]progn
     [b][color=MAROON]([/color][/b]setq layers [b][color=GREEN]([/color][/b]vla-get-layers
                    [b][color=BLUE]([/color][/b]vla-get-ActiveDocument
                      [b][color=RED]([/color][/b]vlax-get-acad-object[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]vlax-for lay  layers
       [b][color=GREEN]([/color][/b]cond [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]eq [color=#2f4f4f]"0"[/color] [b][color=PURPLE]([/color][/b]vla-get-name lay[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
              [b][color=RED]([/color][/b]setq 0lay lay[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
             [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]eq [color=#2f4f4f]"0-From0"[/color] [b][color=PURPLE]([/color][/b]vla-get-name lay[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
              [b][color=RED]([/color][/b]setq 0Nlay lay[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]not 0Nlay[b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]setq 0Nlay [b][color=BLUE]([/color][/b]vla-add layers [color=#2f4f4f]"0-From0"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]vla-put-lock 0lay :vlax-false[b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]vla-put-color 0Nlay [b][color=GREEN]([/color][/b]vla-get-color 0lay[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]vla-put-linetype 0Nlay [b][color=GREEN]([/color][/b]vla-get-linetype 0lay[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]vla-put-lineweight 0Nlay [b][color=GREEN]([/color][/b]vla-get-lineweight 0lay[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]mapcar '[b][color=GREEN]([/color][/b]lambda [b][color=BLUE]([/color][/b]x[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]vla-put-layer x [color=#2f4f4f]"0-From0"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]mapcar 'vlax-ename->vla-object
                     [b][color=BLUE]([/color][/b]mapcar 'cadr [b][color=RED]([/color][/b]ssnamex ss[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]princ [b][color=GREEN]([/color][/b]strcat [color=#2f4f4f]"\n"[/color] [b][color=BLUE]([/color][/b]rtos [b][color=RED]([/color][/b]sslength ss[b][color=RED])[/color][/b] 2 0[b][color=BLUE])[/color][/b] [color=#2f4f4f]" Objects Moved."[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\n<!> No Objects Found on Layer \"[/color]0\[color=#2f4f4f]" <!>"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

leos98 Explorer

leos98

Posted
  • Author
Posted

Hey,

Is that with Notepad++ or Ultraedit?

Lee Mac Grand Master

Lee Mac

Posted
Posted
Hey,

Is that with Notepad++ or Ultraedit?

 

Nah, just ran it through an old LISP I got from David Bethel, puts all the necessary [ color=navy] bits in...

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.

×
 Share
Go to topic listing
×
×
  • Create New...