TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: BREZI on August 17, 2005, 08:55:02 AM

Title: A text font lisp
Post by: BREZI on August 17, 2005, 08:55:02 AM
Anybody got a lisp routine to change all fonts to be the same in a drawing?

much obliged!

 :D
Title: A text font lisp
Post by: Mark on August 17, 2005, 09:19:20 AM
qselect!!
Title: A text font lisp
Post by: BREZI on August 17, 2005, 09:37:19 AM
Cheers use that already its good.

Tell my problem, we get loads of architects drawings with loads of fonts, our standard procedure we change all fonts to romans.

I was think I could use ezscript to run a lisp on afolder of drawings during lunch time or somthing like that.

Im still learning lisp, not good at doing my own yet, I can edit and tweak existing ones no probs.
Title: A text font lisp
Post by: Kerry on August 17, 2005, 09:44:47 AM
BREZI,

One solution that doesn't require modifying the drawings is to remove ALL the font definitions other than ROMANS, and update your font mapping file accordingly.

.. That way when you get revisions to the reference drawings you wont have to repeat the process.

.. .. and it can be demonstrated that you haven't made modifications to design documents .. which may, or may not, be important one day.
Title: A text font lisp
Post by: BREZI on August 17, 2005, 10:06:29 AM
Good idea, but;

Unfortunately I have to produce presentation drawings sometimes, and then we use all of the fancy drawings, and we have to print architects drawings exactly as issued for record purposes.

thanks :o)
Title: A text font lisp
Post by: Kerry on August 17, 2005, 10:10:41 AM
Sure ..
Options, -> Files -> Font File Location

Have 2 folders, one for presentation, one for your special needs.
Flip a switch, you have them all back.
... something you wont have if you change the Font physically

kwb
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 10:10:48 AM
I dont have a LISP version, but I have a vba routine that will do it.  It can be called from a script as well
Title: A text font lisp
Post by: BREZI on August 17, 2005, 10:15:59 AM
Quote from: CmdrDuh
I dont have a LISP version, but I have a vba routine that will do it.  It can be called from a script as well


That would be cool.

cheers.
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 10:16:18 AM
I can upload the file if you need it. Here is the code
Code: [Select]
Option Explicit

Public Sub ChangeTextToRomans()
  Dim objSelected As Object
  Dim objTxt As AcadText
  Dim objstyle As AcadTextStyle
  Dim objLayer As AcadLayer
  Dim objSelSet As AcadSelectionSet
  Dim intAnswer As Integer
  On Error GoTo ErrControl

Set objstyle = ThisDrawing.TextStyles.Add("ROMANS")
objstyle.fontFile = "romans.shx"
objstyle.Width = 1#

  Set objSelSet = ThisDrawing.SelectionSets.Add("Text")
  objSelSet.Select acSelectionSetAll
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
        Set objTxt = objSelected
            If UCase(objTxt.StyleName) <> "ROMANS" Then
            objTxt.StyleName = "ROMANS"
            objTxt.ScaleFactor = 1#
            Else
            objTxt.ScaleFactor = 1#
            End If
        End If
    Next
  ThisDrawing.SelectionSets.Item("Text").Delete
  ThisDrawing.Application.Update
Exit_Here:
  Exit Sub
ErrControl:
  MsgBox Err.Description
End Sub
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 10:20:44 AM
your script would look something like
Quote

open "your dwg name" (command "-vbarun" "E:/TextToRomans.dvb!ThisDrawing.ChangeTextToRomans") qsave close

all you would have to do is change paths to match yours
Title: A text font lisp
Post by: BREZI on August 17, 2005, 10:47:08 AM
Thats great cheers for the help!
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 10:48:49 AM
Glad it worked!  You might need to tweak some of the settings like width factor or preset height.  Also, I didn't put in the error checking to see if the Selection Set existed or not, so that can be added.  I have that code if you need it.
Title: A text font lisp
Post by: BREZI on August 17, 2005, 11:11:47 AM
Dumb question, but how I turn that code into a dvb file?

Never done that before, only worked with lisp & scripts.
Title: A text font lisp
Post by: ronjonp on August 17, 2005, 11:40:26 AM
Hey cmdrduh,

I'm trying to set a font to arial.ttf but it wont work??
Code: [Select]

Dim objstyle As AcadTextStyle

Set objstyle = ThisDrawing.TextStyles.Add("Arial")
objstyle.fontFile = "arial.ttf"
objstyle.Width = 1#


Doest this not work with True Type Fonts?

Thanks,

Ron
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:49:06 AM
Brezi, I'll upload the file, but in a nutshell, open VBAman, create a new project, and add to ThisDrawing or a module of your choice.  Ronjonp, ill post that in a minute
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:50:35 AM
Code: [Select]
Set objstyle = ThisDrawing.TextStyles.Add("TEP-TITLE")
objstyle.fontFile = "VERDANA.TTF"
objstyle.Width = 0.85

I use this for verdana, should work for arial.  Ill test in a minute
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:51:54 AM
Brezi, here is link (http://www.theswamp.org/lilly_pond/cmdrduh/TextToRomans.dvb?nossi=1)
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:54:37 AM
Ronjonp, Autocad cannot find the font under normal pathing, so if you put the ttf in the font folder under autocad, it will work.
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:55:39 AM
Here is both fonts being loaded
Code: [Select]
Option Explicit

Public Sub ChangeTextToRomans()
  Dim objSelected As Object
  Dim objTxt As AcadText
  Dim objstyle As AcadTextStyle
  Dim objLayer As AcadLayer
  Dim objSelSet As AcadSelectionSet
  Dim intAnswer As Integer
  On Error GoTo ErrControl

Set objstyle = ThisDrawing.TextStyles.Add("ROMANS")
objstyle.fontFile = "romans.shx"
objstyle.Width = 1#
Set objstyle = ThisDrawing.TextStyles.Add("Arial")
objstyle.fontFile = "ARIAL.TTF"
objstyle.Width = 0.85

  Set objSelSet = ThisDrawing.SelectionSets.Add("Text")
  objSelSet.Select acSelectionSetAll
    For Each objSelected In objSelSet
        If TypeOf objSelected Is AcadText Then
        Set objTxt = objSelected
            If UCase(objTxt.StyleName) <> "ROMANS" Then
            objTxt.StyleName = "ROMANS"
            objTxt.ScaleFactor = 1#
            Else
            objTxt.ScaleFactor = 1#
            End If
        End If
    Next
  ThisDrawing.SelectionSets.Item("Text").Delete
  ThisDrawing.Application.Update
Exit_Here:
  Exit Sub
ErrControl:
  MsgBox Err.Description
End Sub
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:57:43 AM
Just tested this, if you path the font in windows, it will work W/O coping the font to the font folder.  Im going to test if it works after you close acad
Title: A text font lisp
Post by: CmdrDuh on August 17, 2005, 11:59:39 AM
It held it after I closed autocad.  So, you could path it if needed

Code: [Select]
Set objstyle = ThisDrawing.TextStyles.Add("TEP-TITLE")
objstyle.fontFile = "C:\WINNT\Fonts\ARIAL.TTF"
objstyle.Width = 0.85
Title: A text font lisp
Post by: ronjonp on August 17, 2005, 12:02:32 PM
It works just as long as the font is in one of Acad search paths.

Thanks for your help.

Ron
Title: A text font lisp
Post by: BREZI on August 17, 2005, 12:09:27 PM
Cheers again, will let you know tmrw how I get on.
Title: A text font lisp
Post by: ronjonp on August 17, 2005, 12:10:19 PM
Scratch that....I had the font in a search path still....when I took it out it failed.
Title: A text font lisp
Post by: BREZI on August 19, 2005, 05:35:57 AM
Still not got it working, ive been too busy.

I will report back when I get back onto doing the plans.
Title: A text font lisp
Post by: Jürg Menzi on August 19, 2005, 08:45:14 AM
You can use something like this:
Code: [Select]
(defun C:SetTextFont ( / AcaDoc FntFil FntPth NewFnt WscObj)
 (vl-load-com)
 (setq NewFnt "romans.shx"
       AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       WscObj (vlax-create-object "WScript.Shell")
       FntPth (vla-Item (vlax-get WscObj 'SpecialFolders) "Fonts")
       FntFil (cond
               ((findfile NewFnt) NewFnt)
               ((findfile (strcat FntPth "\\" NewFnt)))
               (T nil)
              )
 )
 (vlax-release-object WscObj)
 (if FntFil
  (progn
   (vla-StartUndoMark AcaDoc)
   (vlax-for Sty (vla-get-TextStyles AcaDoc)
    (vla-put-FontFile Sty FntFil)
   )
   (vla-Regen AcaDoc acAllViewports)
   (vla-EndUndoMark AcaDoc)
  )
  (alert (strcat "Requested font file " NewFnt " not found. "))
 )
 (princ)
)
Title: A text font lisp
Post by: Crank on August 19, 2005, 09:31:14 AM
It's easy to let all textstyles point to the same fontfile. There is no need for a program to do that.
But if you want to do things right, then you've got to change all the text to the same textstyle.
Title: Re: A text font lisp
Post by: mojocole on May 07, 2009, 07:07:56 PM
Enjoyed reading this thread, but didn't find anything elegant to change a dimension style to a new font  (unless I'm missing something about VBA). So, here is my rough n ready script.
This is intended to run in a drawing in which there already exists the dim style you want, and the desired effect will be:

1)to modify that dim style to display romans font, and

2) change all dimensions to that dim style

You'll of course have to edit the text style name "ROMANS" and dim style name "DIM-ROMANS" as desired. You may also have to manually adjust the dimscale of the drawing after running the script, depending on the scale called for in the dimstyle setting, but the font will be changed as intended.
Hope this is helpful to someone. Comments welcome.
cheers
jc

________________________________________________
undo
m
undo
m
-style
ROMANS-AY
romans
0
.8
0
n
n
n
-dimstyle
restore
AYDIM
dim

dimtxsty
ROMANS-AY
exit
ssx

e
dimension

dim
up
p

exit
_____________________________________________________________________


Title: Re: A text font lisp
Post by: mojocole on May 07, 2009, 07:36:46 PM
wowie-zowie.. this thing is powerful. Even changes text styles inside blocks, inside dimensions, and Mtext. ...and it's lightning fast. I have to be careful how I use it -- some things I don't want changed. It would be great to have another version (in addition), which acts only on a selection set.

Thanks, Jurg.

cheers,
jc

You can use something like this:
Code: [Select]
(defun C:SetTextFont ( / AcaDoc FntFil FntPth NewFnt WscObj)
 (vl-load-com)
 (setq NewFnt "romans.shx"
       AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       WscObj (vlax-create-object "WScript.Shell")
       FntPth (vla-Item (vlax-get WscObj 'SpecialFolders) "Fonts")
       FntFil (cond
               ((findfile NewFnt) NewFnt)
               ((findfile (strcat FntPth "\\" NewFnt)))
               (T nil)
              )
 )
 (vlax-release-object WscObj)
 (if FntFil
  (progn
   (vla-StartUndoMark AcaDoc)
   (vlax-for Sty (vla-get-TextStyles AcaDoc)
    (vla-put-FontFile Sty FntFil)
   )
   (vla-Regen AcaDoc acAllViewports)
   (vla-EndUndoMark AcaDoc)
  )
  (alert (strcat "Requested font file " NewFnt " not found. "))
 )
 (princ)
)