Jump to content

save each layer in a separate file


Guest x.bonnet

Recommended Posts

Guest x.bonnet

Hi all,

I'm looking for an automatic way to split a .dwg containing many layers to many .dwg containing only one layer (each layer should be saved separately in a new file using layer name for the new file name).

Does anyone know an easy way to do that ?

Thanks

Xavier

Link to comment
Share on other sites

You could write a lisp file which would do it automatic for you.

 

Another way which is a little cumbersome but does do the job is to use the qselect command.

 

Apply to: entire drawing

 

object type: multiple

 

Properties: layer

 

operator =

 

Value (choose layers indididually each time)

 

wblock

 

File name and path (layer name) and leave everything else

 

ok

 

and start again for the next layer

 

 

hope this helps until someone posts a list routin for you

Link to comment
Share on other sites

Guest x.bonnet

Thanks, that's about what I've been doing...

 

Just a question: what is

 

"wblock

 

File name and path (layer name) and leave everything else

 

ok"

 

where is this function? (I'm using Acad 2005)

This may be quicker than select copy new file paste ?

 

In fact I'm really looking for an automatic way !

Link to comment
Share on other sites

sorry if it was a bit cloudy,

 

press ok button in the qselect (after selection)

 

type wblock in the command line (writeblock)

 

in the File name and path : (type in the layer name)

 

press ok button.

 

a new file will have been created. I was then suggesting starting the loop again with the next layer.

 

It's tolerable in one drawing but a pain with loads.

 

 

hopefully one of the lisp wizards will have produced a routine that does this for you shortly

Link to comment
Share on other sites

Xavier,

hello again.:D

it can certainly be done, the following code will do it but is only proof rather than a finished routine. You will need to understand VBA a little to finish it!

Public Sub GetLayer()
Dim i As Integer
Dim mySelSet As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
Dim SaveName As String

For i = 0 To ThisDrawing.Layers.Count - 1
Set mySelSet = ThisDrawing.SelectionSets.Add("TextOnLayer")
gpCode(0) = 8 'layer
groupCode = gpCode
dataValue(0) = ThisDrawing.Layers(i).Name  'layer name
dataCode = dataValue
mySelSet.Select acSelectionSetAll, , , groupCode, dataCode
Debug.Print mySelSet.Count
ThisDrawing.Wblock "C:\Fred_" & ThisDrawing.Layers(i).Name, mySelSet
Set mySelSet = Nothing
ThisDrawing.SelectionSets.Item("TextOnLayer").Delete
Next
End Sub

 

WBLOCK (write block) is used to create new drawings out of parts of an existing drawing. You can select individual items or a block defined within your drawing.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Guest x.bonnet

Thanks guys!

I'm = 0 with programming, but i'll ask the one who knows (a little more) here...

I'll be back if we can't do it !

 

meanwhile, if somebody has another suggestion...

 

thanks again

 

Xavier

Link to comment
Share on other sites

Guest x.bonnet

Cymro, your way is faster than what I was doing...better than nothing!

In fact, it didn't work the first time I tried because my wblock is spelled wbloc... in french!

Xavier

Link to comment
Share on other sites

One more, with target folder selection.

 

(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 

 

>kpblc It is impossible to keep up with you. :)

Link to comment
Share on other sites

Guest x.bonnet

well....

I downloaded the .vlx file that's supposed to do it (kpblc answer), uploaded the application in Acad (is it what I'm supposed to do ?)... and don't know what to do next !!

a little more help please...

Xavier

LAY2DWG.zip

Link to comment
Share on other sites

Guest x.bonnet

Ok, I found how to make it work ! (load vlx, than type command "lay2dwg) just too easy! It is exactly what I needed !

Thanks to all and a special one to kpblc !

Xavier

Link to comment
Share on other sites

  • 1 month later...
One more, with target folder selection.

 

(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 

>kpblc It is impossible to keep up with you. :)

 

How exactly do i get this to work? I saved the code in a txt file then renamed it to .lsp, did autoload in autocad 2007, but now what ? i can't figure out the command

Link to comment
Share on other sites

I saved the code in a txt file then renamed it to .lsp, did autoload in autocad 2007, but now what ? i can't figure out the command

 

1. Tools>AutoLISP>Load... (Can also add to 'Startup Suite' for automaticlay loading in every open file).

 

2. Type lsave in coomand line.

Link to comment
Share on other sites

  • 3 years later...

Hi,

Is it also possible to save just the active layers (on) in just one file?

 

One more, with target folder selection.

 

(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 

 

>kpblc It is impossible to keep up with you. :)

Link to comment
Share on other sites

Give this a try, added a lot more error trapping to allow for filenames that already exist.

 

;;---------------------=={ Layer 2 DWG }==--------------------;;
;;                                                            ;;
;;  WBlocks all active layers to separate drawings, saved to  ;;
;;  the specified directory                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:Layer2DWG ( / *error* _UniqueFilename _UniqueItem _LayerList doc docname SelSets Path ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _UniqueFileName ( seed )
   (
     (lambda ( i / filename )
       (if (findfile (setq filename (strcat seed ".dwg")))
         (while (findfile (setq filename (strcat seed "(" (itoa (setq i (1+ i))) ").dwg"))))
       )
       filename
     )
     1
   )
 )

 (defun _UniqueItem ( collection seed )
   (
     (lambda ( i )
       (while (LM:Itemp collection (strcat seed (itoa (setq i (1+ i))))))
       (strcat seed (itoa i))
     )
     0
   )
 )

 (defun _LayerList ( doc / l )
   (vlax-for layer (vla-get-layers doc)
     (if
       (not
         (or
           (eq :vlax-false (vla-get-layeron layer))
           (wcmatch (vla-get-name layer) "*|*")
         )
       )
       (setq l (cons (vla-get-name layer) l))
     )
   )
   (reverse l)
 )

 (setq doc     (vla-get-ActiveDocument (vlax-get-acad-object))
       docname (vl-filename-base (vla-get-Name doc))
       SelSets (vla-get-SelectionSets doc))

 (if (setq Path (LM:DirectoryDialog "Select Directory for New Files" nil 0))
   (progn
     (setq ss (vla-Add SelSets (_UniqueItem SelSets "LayerSave")))
     
     (mapcar
       (function
         (lambda ( layer )
           (LM:DXF->Variants (list (cons 8 layer)) 'typ 'val)
           (vla-Select ss acSelectionSetAll nil nil typ val)

           (if (not (zerop (vla-get-Count ss)))
             (progn
               (vla-WBlock doc (_UniqueFilename (strcat Path "\\" docname "_" layer)) ss)
               (princ (strcat "\n>>> Extracted Layer: " layer))
             )
             (princ (strcat "\n[ Nothing Found on Layer: " layer " ]"))
           )
           (vla-clear ss)            
         )
       )
       (_LayerList doc)
     )

     (vl-catch-all-apply 'vla-delete (list ss))
   )
   (princ "\n*Cancel*")
 )

 (princ)
)

;;-------------------=={ Directory Dialog }==-----------------;;
;;                                                            ;;
;;  Displays a dialog prompting the user to select a folder   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - message to display at top of dialog                ;;
;;  dir  - root directory (or nil)                            ;;
;;  flag - bit coded flag specifying dialog display settings  ;;
;;------------------------------------------------------------;;
;;  Returns:  Selected folder filepath, else nil              ;;
;;------------------------------------------------------------;;

(defun LM:DirectoryDialog ( msg dir flag / Shell Fold FObj Path ac )
 ;; © Lee Mac 2010

 (setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
       Fold  (vlax-invoke-method Shell 'BrowseForFolder (vla-get-HWND ac) msg flag dir))
 (vlax-release-object Shell)
 
 (if Fold
   (progn
     (setq FObj (vlax-get-property Fold 'Self))
     (setq Path (vlax-get-property FObj 'Path))
     (vlax-release-object Fold)
     (vlax-release-object FObj)
     
     (and (= "\\" (substr Path (strlen Path)))
          (setq Path (substr Path 1 (1- (strlen Path)))))
   )
 )
 Path
)

;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)

;;------------------=={ DXF->Variants }==---------------------;;
;;                                                            ;;
;;  Converts a DXF List to Type and Value Variants            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst  - DXF List                                           ;;
;;  *typ - a quoted symbol (other than *typ) to house variant ;;
;;  *val - a quoted symbol (other than *val) to house variant ;;
;;------------------------------------------------------------;;

(defun LM:DXF->Variants ( lst *typ *val)
 ;; © Lee Mac 2010
 (set *typ (LM:SafearrayVariant vlax-vbInteger (mapcar 'car lst))) 

 (set *val
   (LM:SafearrayVariant vlax-vbVariant
     (mapcar
      '(lambda ( data )
         (if (listp (setq data (cdr data)))
           (vlax-3D-point data)
           (vlax-make-variant data)
         )
       )
      lst       
     )
   )
 )
)

;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;

(defun LM:Itemp ( coll item )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

Link to comment
Share on other sites

Thank you MAC for the quick answer. Your routine is very useful!!

One more question: Is it possible to save the layers in one dwg-file?

 

Again many thanks for your help!

Link to comment
Share on other sites

Thank you MAC for the quick answer. Your routine is very useful!!

One more question: Is it possible to save the layers in one dwg-file?

 

Again many thanks for your help!

 

You're welcome.

 

Saving layers in one dwg file - surely that's what you start with?

Link to comment
Share on other sites

You're welcome.

 

Saving layers in one dwg file - surely that's what you start with?

 

Not exactly! I have several layers (DXF-File makes 48 MB about 60 layers ) . My task is to select rooms, exits and so on. So just what I need is to activate the layers I modified/added and save them as a DXF-File .

 

Your program do the work, but a file for each layer. It is my first contact with AutoCAD so I still have no experience with is nor with AutoLisp. So I apologize for my newbe questions!

Link to comment
Share on other sites

Give this a shot:

 

;;--------------------=={ Layers 2 DWG }==--------------------;;
;;                                                            ;;
;;  WBlocks all active layers to a separate drawing, as       ;;
;;  specified by the user                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:Layers2DWG ( / *error* _UniqueItem _LayerList doc docname SelSets file ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _UniqueItem ( collection seed )
   (
     (lambda ( i )
       (while (LM:Itemp collection (strcat seed (itoa (setq i (1+ i))))))
       (strcat seed (itoa i))
     )
     0
   )
 )

 (defun _LayerList ( doc / l )
   (vlax-for layer (vla-get-layers doc)
     (if
       (not
         (or
           (eq :vlax-false (vla-get-layeron layer))
           (wcmatch (vla-get-name layer) "*|*")
         )
       )
       (setq l (cons (vla-get-name layer) l))
     )
   )
   (reverse l)
 )

 (setq doc     (vla-get-ActiveDocument (vlax-get-acad-object))
       docname (vl-filename-base (vla-get-Name doc))
       SelSets (vla-get-SelectionSets doc))

 (if (setq file (getfiled "Create Output File" "" "dwg" 1))
   (progn
     (setq ss (vla-Add SelSets (_UniqueItem SelSets "LayerSave")))
     (LM:DXF->Variants (list (cons 8 (LM:lst->str (_LayerList doc) ","))) 'typ 'val)

     (vla-Select ss acSelectionSetAll nil nil typ val)

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

     (vl-catch-all-apply 'vla-delete (list ss))
   )
   (princ "\n*Cancel*")
 )

 (princ)
)

;;------------------=={ Safearray Variant }==-----------------;;
;;                                                            ;;
;;  Creates a populated Safearray Variant of a specified      ;;
;;  data type                                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  datatype - variant type enum (eg vlax-vbDouble)           ;;
;;  data     - list of static type data                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Variant Object of type specified            ;;
;;------------------------------------------------------------;;

(defun LM:SafearrayVariant ( datatype data )
 ;; © Lee Mac 2010
 (vlax-make-variant
   (vlax-safearray-fill
     (vlax-make-safearray datatype
       (cons 0 (1- (length data)))
     )
     data
   )    
 )
)

;;------------------=={ DXF->Variants }==---------------------;;
;;                                                            ;;
;;  Converts a DXF List to Type and Value Variants            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst  - DXF List                                           ;;
;;  *typ - a quoted symbol (other than *typ) to house variant ;;
;;  *val - a quoted symbol (other than *val) to house variant ;;
;;------------------------------------------------------------;;

(defun LM:DXF->Variants ( lst *typ *val)
 ;; © Lee Mac 2010
 (set *typ (LM:SafearrayVariant vlax-vbInteger (mapcar 'car lst))) 

 (set *val
   (LM:SafearrayVariant vlax-vbVariant
     (mapcar
      '(lambda ( data )
         (if (listp (setq data (cdr data)))
           (vlax-3D-point data)
           (vlax-make-variant data)
         )
       )
      lst       
     )
   )
 )
)

;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;

(defun LM:Itemp ( coll item )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

;;-------------------=={ List to String }==-------------------;;
;;                                                            ;;
;;  Constructs a string from a list of strings separating     ;;
;;  each element by a specified delimiter                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - a list of strings to process                        ;;
;;  del - delimiter by which to separate each list element    ;;
;;------------------------------------------------------------;;
;;  Returns:  String containing each string in the list       ;;
;;------------------------------------------------------------;;

(defun LM:lst->str ( lst del )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
 )
)

Link to comment
Share on other sites

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.

×
×
  • Create New...