save each layer in a separate file

[chraibi]

Works like a charm!! Many many thanks!

 

For learning purposes what does the following line do:

(LM : DXF->Variants (list (cons 8 (LM:lst->str (_LayerList doc) ","))) 'typ 'val)

 

I guesse here is the content in the dwg-file saved:

(if (not (zerop (vla-get-Count ss))) (vla-WBlock doc file ss))

 

right?

If I change the suffix "dwg" in "dxf"

setq file (getfiled "Create Output File" "" "dwg" 1))

 

Would I get a dxf-file as a result?

Edited October 2, 2010 by chraibi
space between : and D

[Lee Mac]

Works like a charm!! Many many thanks!

 

Excellent, good to hear.

 

For learning purposes what does the following line do:

(LM : DXF->Variants (list (cons 8 (LM:lst->str (_LayerList doc) ","))) 'typ 'val)

 

Creates two variants - one of integer type and one of variant type to house the data for the selection set filter.

 

I guesse here is the content in the dwg-file saved:

(if (not (zerop (vla-get-Count ss))) (vla-WBlock doc file ss))

 

right?

If I change the suffix "dwg" in "dxf"

setq file (getfiled "Create Output File" "" "dwg" 1))

 

Would I get a dxf-file as a result?

 

I haven't tried, but yes, that is where you would change it.

 

Lee

[chraibi]

Unfortunately it does not work! I googled a little and found this hint:

write:

(setenv"DefaultFormatForSave""13")

bevor:

(if (not (zerop (vla-get-Count ss))) (vla-WBlock doc file ss))

Look at the DefaultFormatForSave environment variable (getenv/setenv

functions)

the values are :

"48" -> dwg 2010

"36" -> dwg 2007

"24" -> dwg 2004

"12" -> dwg 2000

"8" -> dwg R14

"38" -> dwt

"37" -> dxf 2007

"25" -> dxf 2004

"13" -> dxf 2000

"1" -> dxf R12

 

But this fails too! :-(

 

Mybe another Idea?

[mdbdesign]

Thanks Lee, both works OK for me.

[Lee Mac]

You're very welcome MDBDesign

[chraibi]

Lee Mac: I don't know why I can not send you a pm. But do you mind if I publish your code, that you helped me with, on my private homepage? Of corse with a link to yours or to the discussion here.

[Tiger]

Lee Mac: I don't know why I can not send you a pm. But do you mind if I publish your code, that you helped me with, on my private homepage? Of corse with a link to yours or to the discussion here.

 

OU! OU! *waves hand* I know! I know!

 

You can't use the PM-system til you have 10 posts under your belt. This is to prevent spamming mostly.

 

Oh, and in the future, please start a new thread for each new question. I realise that this question is based on the old question, but it confuses things to have a thread form 2006 pop up again.

[chraibi]

Sure! This was impolite from me. I apologize!

[Tiger]

Sure! This was impolite from me. I apologize!

 

Don't worry, now you know

[Lee Mac]

Lee Mac: I don't know why I can not send you a pm. But do you mind if I publish your code, that you helped me with, on my private homepage? Of corse with a link to yours or to the discussion here.

 

Hi Chraibi,

 

Certainly, providing all headers remain in tact I feel honoured to have my code feature elsewhere on the web

 

Lee

[shennig]

Try to use. Look at comments!

;|
Limitations: file sould be opened "full" (not partial). All layers should
be thawed, on, unlocked (not controlled).
Layout entities will create unexpected result - be careful!

Actually there are some ways to change code to select only model entites
But i can't do it - i've got too much job 
And something else  - look how the code works 
* written by kpblc 2006 Nov 23
|;
(defun c:lay2file (/ adoc selset)
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (vlax-for ss (vla-get-selectionsets adoc)
   (if (= (vla-get-name ss) "temp")
     (progn
       (vla-clear ss)
       (vla-erase ss)
       ) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of vlax-for
 (setq selset (vla-add (vla-get-selectionsets adoc) "temp"))
 (vlax-for lay (vla-get-layers adoc)
   (if (and (not (vla-select
                   selset
                   acselectionsetall
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (vlax-make-safearray
                         vlax-vbdouble
                         '(0 . 0)
                         ) ;_ end of vlax-make-safearray
                       '(
                       ) ;_ end of vlax-safearray-fill
                     ) ;_ end of vlax-make-variant
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (vlax-make-safearray
                         vlax-vbvariant
                         '(0 . 0)
                         ) ;_ end of vlax-make-safearray
                       (list (vla-get-name lay))
                       ) ;_ end of vlax-safearray-fill
                     ) ;_ end of vlax-make-variant
                   ) ;_ end of vla-select
                 ) ;_ end of not
            (> (vla-get-count selset) 0)
            ) ;_ end of and
     (vla-wblock
       adoc
       (strcat (getvar "dwgprefix") (vla-get-name lay) ".dwg")
       selset
       ) ;_ end of vla-Wblock
     ) ;_ end of if
   (vla-clear selset)
   ) ;_ end of vlax-for
 (vl-catch-all-apply '(lambda () (vla-delete selset)))
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

At VBA code could be more readable.

this works great....but i was hoping to have the file name as a prefix on the front of the created file before the layer name.can you please tell me where & what to input i have tried several areas but have failed

[Lee Mac]

Here is my version:

 

[color=GREEN];; Layers to Drawings  -  Lee Mac  -  2011  -  www.lee-mac.com[/color]
[color=GREEN];; WBlocks objects on each layer in a drawing to separate drawing files.[/color]

([color=BLUE]defun[/color] c:lay2dwg ( [color=BLUE]/[/color] _UniqueFilename acdoc acsel fpath typevar )

   ([color=BLUE]defun[/color] _UniqueFilename ( seed [color=BLUE]/[/color] f i )
       ([color=BLUE]setq[/color] i 1)
       ([color=BLUE]if[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] f ([color=BLUE]strcat[/color] seed [color=MAROON]".dwg"[/color])))
           ([color=BLUE]while[/color] ([color=BLUE]findfile[/color] ([color=BLUE]setq[/color] f ([color=BLUE]strcat[/color] seed [color=MAROON]"("[/color] ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i))) [color=MAROON]").dwg"[/color]))))
       )
       f
   )

   ([color=BLUE]defun[/color] _UniqueItem ( collection seed [color=BLUE]/[/color] i )
       ([color=BLUE]setq[/color] i 1)
       ([color=BLUE]while[/color]
           ([color=BLUE]null[/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] collection ([color=BLUE]strcat[/color] seed ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)))))
                   )
               )
           )
       )
       ([color=BLUE]strcat[/color] seed ([color=BLUE]itoa[/color] i))
   )

   ([color=BLUE]setq[/color] acdoc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
         acsel ([color=BLUE]vla-get-selectionsets[/color] acdoc)
         acsel ([color=BLUE]vla-add[/color] acsel (_UniqueItem acsel [color=MAROON]"lay2dwg"[/color]))
         fpath ([color=BLUE]strcat[/color] ([color=BLUE]getvar[/color] 'DWGPREFIX) ([color=BLUE]cadr[/color] ([color=BLUE]fnsplitl[/color] ([color=BLUE]getvar[/color] 'DWGNAME))) [color=MAROON]"_"[/color])
   )
   ([color=BLUE]vla-clear[/color] acsel)
   ([color=BLUE]setq[/color] typevar
       ([color=BLUE]vlax-make-variant[/color]
            ([color=BLUE]vlax-safearray-fill[/color]
                ([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbinteger[/color] '(0 . 1)) '(8 410)
            )
       )
   )
   ([color=BLUE]vlax-for[/color] layer ([color=BLUE]vla-get-layers[/color] acdoc)
       ([color=BLUE]vla-select[/color] acsel [color=BLUE]acselectionsetall[/color] [color=BLUE]nil[/color] [color=BLUE]nil[/color] typevar
           ([color=BLUE]vlax-make-variant[/color]
               ([color=BLUE]vlax-safearray-fill[/color]
                   ([color=BLUE]vlax-make-safearray[/color] [color=BLUE]vlax-vbvariant[/color] '(0 . 1)) ([color=BLUE]list[/color] ([color=BLUE]vla-get-name[/color] layer) [color=MAROON]"Model"[/color])
               )
           )
       )
       ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]vla-get-count[/color] acsel))
           ([color=BLUE]progn[/color]
               ([color=BLUE]vla-wblock[/color] acdoc (_UniqueFilename ([color=BLUE]strcat[/color] fpath ([color=BLUE]vla-get-name[/color] layer))) acsel)
               ([color=BLUE]vla-clear[/color] acsel)
           )
       )
   )
   ([color=BLUE]vla-delete[/color] acsel)
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

 

Another alternative here.

[shennig]

thanks lee that is exactly what i was after

[Lee Mac]

You're welcome shennig

[anbard]

Hello all,

 

I have found the Autocad_Script.lsp to be a great help to me, but I was wondering how this could be modified to save each layer in an earlier version of AutoCAD i.e 2000 or R14.

 

Any assistance would be appreciated.

 

John

 

(defun c:lsave(/ actDoc layCol docName dwgName actSel fCount)

(vl-load-com)

(defun BrowseFolder (/ ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
Folder(vlax-invoke-method ShlObj 'BrowseForFolder 0
"Select Folder to create files" 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)

(setq actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
actSel(vla-get-ActiveSelectionSet actDoc)
layCol(vla-get-Layers actDoc)
docName(vla-get-Name actDoc)
fCount 0
); end setq
(if
(setq wntPath
(BrowseFolder))
(progn
(vlax-for lay layCol
(setq layName(vla-get-Name lay)
dwgName
(strcat wntPath "\\"
(vl-filename-base docName)
" - " layName ".dwg")
); end setq
(vla-clear actSel)(vla-erase actSel)
(vla-Select actSel acSelectionSetAll nil nil
(vlax-safearray-fill
(vlax-make-safearray vlax-vbInteger '(0 . 0))
'(
) ; end vla-safearray-fill
(vlax-safearray-fill
(vlax-make-safearray vlax-vbvariant '(0 . 0))
(list layName)
) ; end vla-safearray-fill
) ; end vla-select
(if(/= 0(vla-get-Count actSel))
(vla-WBlock actDoc dwgName actSel)); end if
(setq fCount(1+ fCount))
); end vlax-for
); end progn
); end if
(princ
(strcat "\*** "
(itoa fCount)
" files were created *** "))
(princ)
); end of c:lsave

Edited January 16, 2014 by anbard
wrap code

[SLW210]

Please read the Code posting guidelines and edit your post to include the Code in Code Tags.

[kpblc]

...how this could be modified to save each layer in an earlier version of AutoCAD i.e 2000 or R14...

I think it's impossible. Code uses vla-wblock function. This function can save dwg only at native format.

[mdbdesign]

You can change temporary "save as:" in Tools>Options>Open and Save, to version you need.

[anbard]

Thanks for relying!

 

If it's impossible then the other option is to open the files and saveas version required as suggested, I started this today. If there is a batch way of doing this I'm open to suggestion but limited in programming skills! Willing to learn but just need direction!

 

Many thanks again,

 

John

[kpblc]

> mdbdesign : I think this step won't change vla-wblock functionality. As i know this function use ObjectDBX mechanism.