Jump to content

Generate dwg for each layer

MastroLube

By MastroLube
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

MastroLube Community Regular

MastroLube

Posted
Posted

Hi there, can you help me to fix this code? It doesn't work very well...

 

I've a source dwg with 5 layers, I want to generate 4 dwg with "BORDO" and one of the other.

Example:

1. BORDO + ARMAT_INF_DIR_X

2. BORDO + ARMAT_INF_DIR_Y

3. BORDO + ARMAT_SUP_DIR_X

4. BORDO + ARMAT_SUP_DIR_Y

 

This is the code:

(defun c:test    (/ continue first name next_lay lay_name objects bordo)
 (setq    continue t
   first     t
   name     (getvar "dwgname")
   name     (substr name 1 (- (strlen name) 4))
   name     (strcat (getvar "dwgprefix") name)
 )
 
(setq bordo (ssget "X" (list (cons 8 "BORDO"))))

 (while continue
   (setq next_lay (tblnext "LAYER" first)
     first       nil
     objects nil
   )
   (setq lay_name (cdr (assoc 2 next_lay)))
   

   (if    (not next_lay)
     (setq continue nil)
     (progn
   (setq objects (ssget "X" (list (cons 8 lay_name))))
   (if (and objects (/= lay_name "BORDO"))
     (progn
       (setq lay_name (cdr (assoc 2 next_lay)))
       (setq objects (ssgetunion objects bordo))
       (command "-wblock")
       (command (strcat name "_" lay_name))
       (command "" (list 0 0 0))
       (command objects "")
       (command "oops")
     )
     
   )
     )
   )
 )
 (princ)
)

 (defun ssgetunion (sel2 sel1 /)
 (if sel1
   (if sel2
     (progn
       (setq ct 0)
       (repeat (sslength sel2)
         (ssadd (ssname sel2 ct) sel1)
         (setq ct (1+ ct))
       )
     )
     sel1
   )
   (princ "\nNIL.")
 )
 sel1
)

 

Looks like the last file has all the layers. I set objects to "nil" every cycle so I don't understand the reason ...

 

Thank you!

Dennis

 

arm.dwg

Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

Consider the following code:

([color=BLUE]defun[/color] c:lay2dwg ( [color=BLUE]/[/color] bor doc dwg idx lst sel ssc sso tmp typ val )
   ([color=BLUE]setq[/color] dwg ([color=BLUE]strcat[/color] ([color=BLUE]getvar[/color] 'dwgprefix) ([color=BLUE]vl-filename-base[/color] ([color=BLUE]getvar[/color] 'dwgname)))
         doc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         ssc ([color=BLUE]vla-get-selectionsets[/color] doc)
         typ ([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbinteger[/color] '(0 . 1))
         val ([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbvariant[/color] '(0 . 1))
         tmp 0
   )
   ([color=BLUE]vlax-safearray-put-element[/color] typ 0 
   ([color=BLUE]vlax-safearray-put-element[/color] typ 1 410)
   ([color=BLUE]vlax-safearray-put-element[/color] val 1 [color=MAROON]"Model"[/color])
   ([color=BLUE]while[/color]
       ([color=BLUE]not[/color]
           ([color=BLUE]vl-catch-all-error-p[/color]
               ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-item[/color]
                   ([color=BLUE]list[/color] ssc ([color=BLUE]strcat[/color] [color=MAROON]"lay2dwg"[/color] ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]1+[/color] tmp)))))
               )
           )
       )
   )
   ([color=BLUE]setq[/color] sso ([color=BLUE]vla-add[/color] ssc ([color=BLUE]strcat[/color] [color=MAROON]"lay2dwg"[/color] ([color=BLUE]itoa[/color] tmp))))
   
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color] '((8 . [color=MAROON]"BORDO"[/color]) (410 . [color=MAROON]"Model"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx)
                     lst ([color=BLUE]cons[/color] ([color=BLUE]vlax-ename->vla-object[/color] ([color=BLUE]ssname[/color] sel idx)) lst)
               )
           )
           ([color=BLUE]setq[/color] bor
               ([color=BLUE]vlax-make-variant[/color]
                   ([color=BLUE]vlax-safearray-fill[/color]
                       ([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbobject[/color] ([color=BLUE]cons[/color] 0 ([color=BLUE]1-[/color] ([color=BLUE]length[/color] lst))))
                       lst
                   )
               )
           )
       )
   )
   
   ([color=BLUE]vlax-for[/color] lay ([color=BLUE]vla-get-layers[/color] doc)
       ([color=BLUE]if[/color] ([color=BLUE]/=[/color] [color=MAROON]"BORDO"[/color] ([color=BLUE]strcase[/color] ([color=BLUE]vla-get-name[/color] lay)))
           ([color=BLUE]progn[/color]
               ([color=BLUE]vlax-safearray-put-element[/color] val 0 ([color=BLUE]vla-get-name[/color] lay))
               ([color=BLUE]vla-clear[/color]  sso)
               ([color=BLUE]vla-select[/color] sso [color=BLUE]acselectionsetall[/color] [color=BLUE]nil[/color] [color=BLUE]nil[/color] ([color=BLUE]vlax-make-variant[/color] typ) ([color=BLUE]vlax-make-variant[/color] val))
               ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]vla-get-count[/color] sso))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]if[/color] bor ([color=BLUE]vla-additems[/color] sso bor))
                       ([color=BLUE]vla-wblock[/color] doc (LM:uniquefilename ([color=BLUE]strcat[/color] dwg [color=MAROON]"_"[/color] ([color=BLUE]vla-get-name[/color] lay) [color=MAROON]".dwg"[/color])) sso)
                   )
               )
           )
       )
   )
   ([color=BLUE]vla-delete[/color] sso)
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Unique Filename  -  Lee Mac[/color]
[color=GREEN];; Returns a filename suffixed with the smallest integer required for uniqueness[/color]

([color=BLUE]defun[/color] LM:uniquefilename ( fnm )
   ([color=BLUE]if[/color] ([color=BLUE]findfile[/color] fnm)
       ([color=BLUE]apply[/color]
          '([color=BLUE]lambda[/color] ( pth bse ext [color=BLUE]/[/color] tmp )
               ([color=BLUE]setq[/color] tmp 1)
               ([color=BLUE]while[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] fnm ([color=BLUE]strcat[/color] pth bse [color=MAROON]"("[/color] ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] tmp ([color=BLUE]1+[/color] tmp))) [color=MAROON]")"[/color] ext))))
           )
           ([color=BLUE]fnsplitl[/color] fnm)
       )
   )
   fnm
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Edited by Lee Mac
Added (if bor (vla-additems sso bor))
MastroLube Community Regular

MastroLube

Posted
  • Author
Posted

WOW thanks Lee!

 

This code is very complex to me, I'll need a while to understand every line :)

 

Thank you very much for your help

:D

Lee Mac Grand Master

Lee Mac

Posted
Posted
WOW thanks Lee!

 

This code is very complex to me, I'll need a while to understand every line :)

 

Thank you very much for your help

:D

 

You're most welcome - I've tweaked the code to account for circumstances in which there are no objects on the BORDO layer.

MastroLube Community Regular

MastroLube

Posted
  • Author
Posted
You're most welcome - I've tweaked the code to account for circumstances in which there are no objects on the BORDO layer.

 

Oh nice :) you're very kind!

 

If I had your skills I would work half a day ahah

 

Thank you again, see you soon :)) :D

Grrr Veteran

Grrr

Posted
Posted

If I had your skills I would work half a day ahah

 

But you would code on the other half... ;)

 

And GJ Lee! :thumbsup:

MastroLube Community Regular

MastroLube

Posted
  • Author
Posted (edited)
But you would code on the other half... ;)

 

And GJ Lee! :thumbsup:

 

ahah indeed!!

 

May I ask something else?

 

I'm looking at the code and I have few questions..

1) Is it possible to overwrite the file instead of generate another with a different name with this function "LM:uniquefilename"?

 

2) Is it possible to change the file format output of write block to, for example, autocad 2009?

(vla-wblock doc (LM:uniquefilename (strcat dwg "_" (vla-get-name lay) ".dwg")) sso)

I've googled for this function "(vla-wblock .." but I dind't find anything.

 

Thanks :)

Edited by MastroLube
Lee Mac Grand Master

Lee Mac

Posted
Posted
I'm looking at the code and I have few questions..

1) Is it possible to overwrite the file instead of generate another with a different name with this function "LM:uniquefilename"?

 

Yes - change:

(vla-wblock doc (LM:uniquefilename (strcat dwg "_" (vla-get-name lay) ".dwg")) sso)

To:

(vla-wblock doc (strcat dwg "_" (vla-get-name lay) ".dwg") sso)

And remove the function definition for my LM:uniquefilename function if you wish, as this is no longer used.

 

2) Is it possible to change the file format output of write block to, for example, autocad 2009?

(vla-wblock doc (LM:uniquefilename (strcat dwg "_" (vla-get-name lay) ".dwg")) sso)

I've googled for this function "(vla-wblock .." but I dind't find anything.

 

I may be wrong, but I'm not sure that this is possible to achieve without subsequently saving the drawing in a new format.

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