Author Topic: A text font lisp  (Read 10219 times)

0 Members and 1 Guest are viewing this topic.

BREZI

  • Guest
A text font lisp
« 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

Mark

  • Custom Title
  • Seagull
  • Posts: 28683
A text font lisp
« Reply #1 on: August 17, 2005, 09:19:20 AM »
qselect!!
TheSwamp.org  (serving the CAD community since 2003)

BREZI

  • Guest
A text font lisp
« Reply #2 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.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
A text font lisp
« Reply #3 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.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

BREZI

  • Guest
A text font lisp
« Reply #4 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)

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
A text font lisp
« Reply #5 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
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

--> Donate to theSwamp<--

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #6 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

BREZI

  • Guest
A text font lisp
« Reply #7 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.

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #8 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #9 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

BREZI

  • Guest
A text font lisp
« Reply #10 on: August 17, 2005, 10:47:08 AM »
Thats great cheers for the help!

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #11 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.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

BREZI

  • Guest
A text font lisp
« Reply #12 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.

ronjonp

  • Needs a day job
  • Posts: 7077
A text font lisp
« Reply #13 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

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #14 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #15 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #16 on: August 17, 2005, 11:51:54 AM »
Brezi, here is link
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #17 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.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #18 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #19 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
A text font lisp
« Reply #20 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

ronjonp

  • Needs a day job
  • Posts: 7077
A text font lisp
« Reply #21 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

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

BREZI

  • Guest
A text font lisp
« Reply #22 on: August 17, 2005, 12:09:27 PM »
Cheers again, will let you know tmrw how I get on.

ronjonp

  • Needs a day job
  • Posts: 7077
A text font lisp
« Reply #23 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.

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

BREZI

  • Guest
A text font lisp
« Reply #24 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.

Jürg Menzi

  • Swamp Rat
  • Posts: 597
  • Oberegg, Switzerland
A text font lisp
« Reply #25 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)
)
A computer's human touch is its unscrupulousness!
MENZI ENGINEERING GmbH
Current A2k14... A2k18 - Start R2.18

Crank

  • Swamp Rat
  • Posts: 1443
A text font lisp
« Reply #26 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.

 Vault Professional 2018     /      Building Design Suite Ultimate 2017     /     AEC Collection 2018 + 2019 +2020

mojocole

  • Guest
Re: A text font lisp
« Reply #27 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
_____________________________________________________________________



mojocole

  • Guest
Re: A text font lisp
« Reply #28 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)
)