Text style and layer routine

[CAD89]

Is there any way to make a lisp routine that can append all layers and styles of text existent in a drawing to a list?!

I.E.: I have a drawing that has 5 different layers (let's say "0" "Dimensions" "Lines" "Text" and "Paper space"), and I want to make a lisp that searches through the dwg and appends the layers to a list ... is that possible?

And

I have about 3 text styles ("Standard" "Title" and "Date") and an empty list! How do I get my routine to find the text styles and store them into the empty list?

 

Or it would be much better if I could make a list box containing all available fonts just to select one of them!

 

Thanks in advance!

With regards Csaba Arpad Dobai!

[CAD89]

Solved the layer problem:

 

(defun pad:ll ()
 (setq la (cdr (assoc 2 (tblnext "Layer" T))))
 (setq lal (list la))
 (while (/= (setq la (cdr (assoc 2 (tblnext "Layer")))) nil)
   (setq lal (append	lal (list la))
   )
 )
)

 

I think it works the same with the text styles!

 

Still need help with the fonts though!

[Tharwat]

(defun _List (typ / lst)
 (while (setq e (tblnext typ (null e))) (setq lst (cons (cdr (assoc 2 e)) lst)))
 lst
)

 

usage ...

With Layers ...

 

(_List "Layer")

 

usage ...

With Text Styles ...

 

(_List "Style")

[CAD89]

Thank you for your help! Any idea about the fonts list? I would need something like in the text style dialog box! Is it possible?

[Tharwat]

Thank you for your help!

 

You're welcome .

 

Any idea about the fonts list? I would need something like in the text style dialog box! Is it possible?

 

Do you mean to list all the fonts that are used in the text styles list ?

[CAD89]

Yes! Is that in any way possible?

 

Updated the layer code:

(defun pad:ll ()
 (setq la (cdr (assoc 2 (tblnext "Layer" T))))
 (setq lal (list la))
 (while (/= (setq la (cdr (assoc 2 (tblnext "Layer")))) nil)
   (setq lal (append lal (list la))
   )
 )
 (if (= lal (list nil))
   (setq lal (list (cdr (assoc 2 (tblnext "Layer" T)))))
   (setq lal (append lal (list "Use current" "Make new ...")))
 )
)

 

... for some reason the code gave me a nil list if there was only one layer so I updated and added two more items that I will need later on!

 

Thank you for your time Tharwat!

[Tharwat]

Check this out ...

 

(defun _List-Fonts (/ e lst)
 (while (setq e (tblnext "Style" (null e))) (setq lst (cons (cdr (assoc 3 e)) lst)))
 lst
)

 

(_list-Fonts)

[CAD89]

I'm sorry but the code you wrote will return a list of only the fonts that are currently set or assigned to existent text styles and not a font list of every font that AutoCAD has in it's fonts library!

[Tharwat]

I'm sorry but the code you wrote will return a list of only the fonts that are currently set or assigned to existent text styles and not a font list of every font that AutoCAD has in it's fonts library!

 

That's why I asked you before as you can see below ..

 

Do you mean to list all the fonts that are used in the text styles list ?

 

Anyway here is a routine to list all your shx fonts from the FONTS folder but

don't forget to change the path according to yours .

 

(defun _List-Fonts nil
 (foreach shx (vl-directory-files "C:\\Program Files\\Autodesk\\AutoCAD 2013\\Fonts" "*.shx" 1)
   (print shx)
 )
)

[Lee Mac]

Perhaps something like:

 

([color=BLUE]defun[/color] _getfontlist ( [color=BLUE]/[/color] _parsepaths )

   ([color=BLUE]defun[/color] _parsepaths ( s [color=BLUE]/[/color] p )
       ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p ([color=BLUE]vl-string-position[/color] 59 s))
           ([color=BLUE]vl-remove[/color] [color=MAROON]""[/color] ([color=BLUE]cons[/color] ([color=BLUE]substr[/color] s 1 p) (_parsepaths ([color=BLUE]substr[/color] s ([color=BLUE]+[/color] p 2)))))
           ([color=BLUE]list[/color] s)
       )
   )

   ([color=BLUE]vl-sort[/color]
       ([color=BLUE]apply[/color] '[color=BLUE]append[/color]
           ([color=BLUE]cons[/color] ([color=BLUE]vl-directory-files[/color] (LM:SpecialFolder [color=MAROON]"Fonts"[/color]) [color=MAROON]"*.ttf"[/color] 1)
               ([color=BLUE]mapcar[/color]
                   ([color=BLUE]function[/color]
                       ([color=BLUE]lambda[/color] ( p ) ([color=BLUE]vl-directory-files[/color] p [color=MAROON]"*.shx"[/color] 1))
                   )
                   (_parsepaths ([color=BLUE]getenv[/color] [color=MAROON]"ACAD"[/color]))
               )
           )
       )
       '[color=BLUE]<[/color]
   )
)

[color=GREEN];; Special Folder  -  Lee Mac[/color]
[color=GREEN];; Queries the WshSpecialFolders collection for the specified folder[/color]
[color=GREEN];; Ref: http://msdn.microsoft.com/en-us/library/9x9e7edx%28v=vs.85%29.aspx[/color]

([color=BLUE]defun[/color] LM:SpecialFolder ( folder [color=BLUE]/[/color] res spf wsh )
   ([color=BLUE]setq[/color] res
       ([color=BLUE]vl-catch-all-apply[/color]
           ([color=BLUE]function[/color]
               ([color=BLUE]lambda[/color] ( )
                   ([color=BLUE]setq[/color] wsh ([color=BLUE]vlax-get-or-create-object[/color] [color=MAROON]"wscript.shell"[/color])
                         spf ([color=BLUE]vlax-get-property[/color] wsh 'specialfolders)
                   )
                   ([color=BLUE]vlax-invoke-method[/color] spf 'item folder)
               )
           )
       )
   )
   ([color=BLUE]if[/color] spf  ([color=BLUE]vlax-release-object[/color]  spf))
   ([color=BLUE]if[/color] wsh  ([color=BLUE]vlax-release-object[/color]  wsh))
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] res))
       res
   )
)

 

(untested code)

[CAD89]

Thank you for your time Tharwat and Lee Mac ... This was what I was looking for!

[Tharwat]

Thank you for your time Tharwat and Lee Mac ... This was what I was looking for!

 

Happy to help .

[Lee Mac]

You're welcome CAD89

[leo321]

thank a lot