Message 1 of 6
BatchFile text size example
Not applicable
03-07-2000
07:49 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
'With help from one and all I got a Batch file going. This
'one gets a Dir and new textsize from the user, then modifys the text,
'and resaves each dwg. I did 80 dwg's with it. I got pretty interested
'in batch files doing 'this. If anyone has any other nice batch files
'kicking around I would enjoy to receive them here or at my own e-mail
'Thanks all, and good luck! jim kitts
'Paste this into a module, then 'vbarun' at the command line
'
Dim TextSize As String 'load in 'SetCadBatch()
'TextSize used in SizeTxt()
Sub SetCadBatch()
'Ck if a live ACADDoc exists or make one
'get data from input boxs and trap errors
'jimbo\3:00 pm 3/6/00
'C:\JimJunk\Fundy4\X2 'my Fundy Park test file
'if user killed all dwg's add
'a blank to prevent an error
If Application.Documents.Count = 0 Then
Dim docObjNew As AcadDocument
Set docObjNew = Application.Documents.Add
End If
'at least one dwg is loaded
'so chose a drawing file
Dim dwgName As String
Dim msg As String: Dim title As String
msg = "Where is the Batch Directory?"
title = "Give it to me, baby!"
Dim inDir As String
inDir = InputBox(msg, title)
'check for a cancel
If inDir = "" Then
Exit Sub
End If
'ck if file exists if not, then exit
Dim tmp As String
temp = Dir$(inDir & "\*.dwg")
If temp = "" Then
MsgBox "Ain't no dwg here!"
Exit Sub
End If
msg = "What size do you want your text?"
title = "New Text Size"
TextSize = InputBox(msg, title) 'Dim in Declare
If TextSize = "" Then
Exit Sub 'trap cancel
End If
If Not IsNumeric(TextSize) Then 'trap text
MsgBox "Gotta give a number..."
Exit Sub
End If '
'loop through the files:
Dim filenom As String
filenom = Dir$(inDir & "\*.dwg")
Do While filenom <> ""
Dim WholeFile As String
WholeFile = inDir & "\" & filenom
'do somthin next
DoEvents
ThisDrawing.Application.Documents.Open WholeFile
DoEvents
Call SizeTxt 'reach out for the main routine
ThisDrawing.Close (True) ' gives a save
DoEvents
'end do somethin part
'set tmp to loop through again
filenom = Dir$
Loop
End Sub
'
Private Sub SizeTxt()
Dim elem As Object
Dim found As Boolean
' this is from the Acad examples
'Cycle through the entities in the ModelSpace
For Each elem In ThisDrawing.ModelSpace
With elem
If (.EntityName = "AcDbText") Or (.EntityName = "AcDbMText") Then
' Change the height of the text entity
.Height = TextSize '0.5 'dim in declarations
.Update
found = True
End If
End With
Set elem = Nothing
Next elem
' If we didn't find text, notify user
If Not found Then
MsgBox "No text found in ModelSpace.", vbInformation
End If
End Sub
'done for now, jim kitts
'one gets a Dir and new textsize from the user, then modifys the text,
'and resaves each dwg. I did 80 dwg's with it. I got pretty interested
'in batch files doing 'this. If anyone has any other nice batch files
'kicking around I would enjoy to receive them here or at my own e-mail
'Thanks all, and good luck! jim kitts
'Paste this into a module, then 'vbarun' at the command line
'
Dim TextSize As String 'load in 'SetCadBatch()
'TextSize used in SizeTxt()
Sub SetCadBatch()
'Ck if a live ACADDoc exists or make one
'get data from input boxs and trap errors
'jimbo\3:00 pm 3/6/00
'C:\JimJunk\Fundy4\X2 'my Fundy Park test file
'if user killed all dwg's add
'a blank to prevent an error
If Application.Documents.Count = 0 Then
Dim docObjNew As AcadDocument
Set docObjNew = Application.Documents.Add
End If
'at least one dwg is loaded
'so chose a drawing file
Dim dwgName As String
Dim msg As String: Dim title As String
msg = "Where is the Batch Directory?"
title = "Give it to me, baby!"
Dim inDir As String
inDir = InputBox(msg, title)
'check for a cancel
If inDir = "" Then
Exit Sub
End If
'ck if file exists if not, then exit
Dim tmp As String
temp = Dir$(inDir & "\*.dwg")
If temp = "" Then
MsgBox "Ain't no dwg here!"
Exit Sub
End If
msg = "What size do you want your text?"
title = "New Text Size"
TextSize = InputBox(msg, title) 'Dim in Declare
If TextSize = "" Then
Exit Sub 'trap cancel
End If
If Not IsNumeric(TextSize) Then 'trap text
MsgBox "Gotta give a number..."
Exit Sub
End If '
'loop through the files:
Dim filenom As String
filenom = Dir$(inDir & "\*.dwg")
Do While filenom <> ""
Dim WholeFile As String
WholeFile = inDir & "\" & filenom
'do somthin next
DoEvents
ThisDrawing.Application.Documents.Open WholeFile
DoEvents
Call SizeTxt 'reach out for the main routine
ThisDrawing.Close (True) ' gives a save
DoEvents
'end do somethin part
'set tmp to loop through again
filenom = Dir$
Loop
End Sub
'
Private Sub SizeTxt()
Dim elem As Object
Dim found As Boolean
' this is from the Acad examples
'Cycle through the entities in the ModelSpace
For Each elem In ThisDrawing.ModelSpace
With elem
If (.EntityName = "AcDbText") Or (.EntityName = "AcDbMText") Then
' Change the height of the text entity
.Height = TextSize '0.5 'dim in declarations
.Update
found = True
End If
End With
Set elem = Nothing
Next elem
' If we didn't find text, notify user
If Not found Then
MsgBox "No text found in ModelSpace.", vbInformation
End If
End Sub
'done for now, jim kitts