VBA Basics

My first exercise in VBA was to produce a drawing that saves itself in a certain location and the has a circle at a set coordinate with text in the centre.

After a few amendments I quickly achieved my goal and small level of pride.

Anyway, I decided that to continue my education it would be best to just make this macro as advanced as possible going up step by step.

Unfortunately, I got stuck when trying to amend the code so that the text would be justified middle centre.

Using the help menu I found the code I needed, but couldn't quite work out exactly how it needs to be implemented.

So, does anyone know how I need to arrange the code?

If you could post the code that would help.

Ok, I saved it on the works PC, so I'll do it first thing tomorrow.

Essentialy though, I declared the string, height and insertion point and then set them all. Following that I added some text and used the above values in brackets at the end. Then I got stuck finding out where to add the justification, and was wondering whether I needed to declare and set its value.

This will change text to Right Justified, should point you in general direction

Public Sub RText()
     Dim objSelected As Object
     Dim objTxt As AcadText
     Dim objSelSet As AcadSelectionSet
     Dim dblAlignmentPoint(0 To 2) As Double
     On Error GoTo ErrControl
     Dim strValue As String
     Dim N As Integer
     If ThisDrawing.SelectionSets.Count > 0 Then
           For N = 0 To ThisDrawing.SelectionSets.Count - 1
                 If ThisDrawing.SelectionSets.Item(N).Name = "TEXT" Then
                       ThisDrawing.SelectionSets("TEXT").Delete
                 End If
           Next N
     End If
     Set objSelSet = ThisDrawing.SelectionSets.Add("Text")
     objSelSet.SelectOnScreen
     For Each objSelected In objSelSet
           If TypeOf objSelected Is AcadText Then
                 Set objTxt = objSelected
                 If objTxt.Alignment = acAlignmentLeft Then
                       dblAlignmentPoint(0) = objTxt.InsertionPoint(0)
                       dblAlignmentPoint(1) = objTxt.InsertionPoint(1)
                       dblAlignmentPoint(2) = objTxt.InsertionPoint(2)
                       objTxt.Alignment = acAlignmentRight
                       objTxt.TextAlignmentPoint = dblAlignmentPoint
                 Else
                       dblAlignmentPoint(0) = objTxt.TextAlignmentPoint(0)
                       dblAlignmentPoint(1) = objTxt.TextAlignmentPoint(1)
                       dblAlignmentPoint(2) = objTxt.TextAlignmentPoint(2)
                       objTxt.Alignment = acAlignmentRight
                       objTxt.TextAlignmentPoint = dblAlignmentPoint
                 End If
           End If
     Next
     ThisDrawing.SelectionSets.Item("Text").Delete
     ThisDrawing.Application.Update
Exit_Here:
     Exit Sub
ErrControl:
     MsgBox Err.Description
     ThisDrawing.SelectionSets.Item("Text").Delete
End Sub

Public Sub NewDrgCircleText()

ThisDrawing.Application.Documents.Add

Dim CirinsPoint(0 To 2) As Double 'Declares circle's insertion point

Dim CirRad As Double 'Declares radius of circle

Dim Cir As AcadCircle 'Declares circle object

Dim textHeight As Double 'Declares text height

Dim textStr As String 'Declares text string

Dim textObj As AcadText 'Declares text object

Dim textAlign As Double 'Declares text alignment

CirinsPoint(0) = 500 'Set insertion point x coordinate

CirinsPoint(1) = 500 'Set insertion point y coordinate

CirinsPoint(2) = 0 'Set insertion point z coordinate

CirRad = 50 'Set the Circle's diameter

textHeight = 5 'Set the text height to 20.0

textStr = "DS1000" 'Set the text string

'Create the Circle object

Set Cir = ThisDrawing.ModelSpace.AddCircle(CirinsPoint, CirRad)

'Create the text object

Set textObj = ThisDrawing.ModelSpace.AddText(textStr, CirinsPoint, textHeight)

textObj.Alignment = acAlignmentMiddleCenter

'Save the drawing to the desktop

ThisDrawing.SaveAs ("C:\Documents and Settings\39925nt\Desktop\DS1000.dwg")

End Sub

Above is the basic code I am trying to put together. If the mistakes seem glaringly obvious then please point them out as this is my first real attempt.

the problem I am having is that opposed to aligning the text Middle Center of its insertion point, it is not aligning correctly but setting the insertion point as the drawings origin (0,0).

Can anyone tell me what is wrong?

Cheers

I finally cracked it:

Public Sub NewDrgCircleText()

ThisDrawing.Application.Documents.Add

Dim CirinsPoint(0 To 2) As Double 'Declares circle's insertion point

Dim CirRad As Double 'Declares radius of circle

Dim Cir As AcadCircle 'Declares circle object

Dim textHeight As Double 'Declares text height

Dim textStr As String 'Declares text string

Dim textObj As AcadText 'Declares text object

Dim textAlign(0 To 2) As Double 'Declares text alignment points

'Define the circle

CirinsPoint(0) = 500 'Set insertion point x coordinate

CirinsPoint(1) = 500 'Set insertion point y coordinate

CirinsPoint(2) = 0 'Set insertion point z coordinate

CirRad = 50 'Set the Circle's diameter

'Define the text

textHeight = 5 'Set the text height to 20.0

textStr = "DS1000" 'Set the text string

textAlign(0) = 500

textAlign(1) = 500

textAlign(2) = 0

'Create the text object

Set textObj = ThisDrawing.ModelSpace.AddText(textStr, CirinsPoint, textHeight)

'Set the text alignment to acAlignmentMiddleCenter

textObj.Alignment = acAlignmentMiddleCenter

'Create the text reference points

textObj.TextAlignmentPoint = CirinsPoint

 

'Create the Circle object

Set Cir = ThisDrawing.ModelSpace.AddCircle(CirinsPoint, CirRad)

 

 

 

'Save the drawing to the desktop

ThisDrawing.SaveAs ("C:\Documents and Settings\39925nt\Desktop\DS1000.dwg")

End Sub

I obviously need to tidy up and remove the unnecessary lines of code, thoug.

***Edit: Please see next post***

Having completed my basic requirements (with help from this forum) I set myself new requirements for the current project.

what I want to achieve is to create a new text style and set the font to arial. Then, the text previously created (DS1000) needs to be added to that style.

Having spent about an hour or two trying different ways to achieve this, I am having troubling actually settting the font for the new style (which I want to be Arial).

Unfortunately the built in help isnt as useful as you guys sometimes; so please can anyone help?

Below is my current code:

Public Sub NewDrgCircleText()

ThisDrawing.Application.Documents.Add

Dim CirinsPoint(0 To 2) As Double 'Declares circle's insertion point

Dim CirRad As Double 'Declares radius of circle

Dim Cir As AcadCircle 'Declares circle object

Dim textHeight As Double 'Declares text height

Dim textStr As String 'Declares text string

Dim textObj As AcadText 'Declares text object

Dim NewText As AcadTextStyle 'Decalres the new text style

 

'Define the circle

CirinsPoint(0) = 500 'Set insertion point x coordinate

CirinsPoint(1) = 500 'Set insertion point y coordinate

CirinsPoint(2) = 0 'Set insertion point z coordinate

CirRad = 50 'Set the Circle's diameter

 

'Define the text

textHeight = 5 'Set the text height to 20.0

textStr = "DS1000" 'Set the text string

 

'Create the new text style (DS1000Text)

Set NewText = ThisDrawing.TextStyles.Add("DS1000Text")

NewText.Height = 5

'Set the font for DS1000Text

 

'Create the text object

Set textObj = ThisDrawing.ModelSpace.AddText(textStr, CirinsPoint, textHeight)

 

'Set the text alignment to acAlignmentMiddleCenter

textObj.Alignment = acAlignmentMiddleCenter

 

'Create the text reference points

textObj.TextAlignmentPoint = CirinsPoint

 

'Set the text to new style (DS1000Text)

textObj.TextStyle = "DS1000Text"

 

'Create the Circle object

Set Cir = ThisDrawing.ModelSpace.AddCircle(CirinsPoint, CirRad)

 

'Save the drawing to the desktop

ThisDrawing.SaveAs ("C:\Documents and Settings\39925nt\Desktop\DS1000.dwg")

End Sub

***Edit*** Setting the new text style as the active text style immediately after creating it worked, but I would still be keen to know if I can set the text style of certain text to a style that has been created but not necessarily the active style.

Ok, I think I am getting there now.

Having managed to create the next text style and asssign a font style that is saved in the AutoCAD fonts folder, I still don't quite understand how I choose other fonts like Arial, that arent stored in the fonts folder. Do some of the font files contain multiple font styles? And if so, how do I tell VBA to find them?

Cheers.

Current Code:

Public Sub NewDrgCircleText()

 

ThisDrawing.Application.Documents.Add

 

Dim CirinsPoint(0 To 2) As Double 'Declares circle's insertion point

Dim CirRad As Double 'Declares radius of circle

Dim Cir As AcadCircle 'Declares circle object

Dim textHeight As Double 'Declares text height

Dim textStr As String 'Declares text string

Dim textObj As AcadText 'Declares text object

Dim NewText As AcadTextStyle 'Decalres the new text style

Dim newFontFile As String 'Declares the new fony

 

'Define the circle

CirinsPoint(0) = 500 'Set insertion point x coordinate

CirinsPoint(1) = 500 'Set insertion point y coordinate

CirinsPoint(2) = 0 'Set insertion point z coordinate

CirRad = 50 'Set the Circle's diameter

 

'Define the text

textHeight = 5 'Set the text height to 20.0

textStr = "DS1000" 'Set the text string

 

'Create the new text style (DS1000Text)

Set NewText = ThisDrawing.TextStyles.Add("DS1000Text")

NewText.Height = 5

 

'Set the font for DS1000Text

newFontFile = "C:\Program Files\AutoCAD 2007\Fonts\isocp.shx"

NewText.fontFile = newFontFile

 

'Create the text object

Set textObj = ThisDrawing.ModelSpace.AddText(textStr, CirinsPoint, textHeight)

 

'Set the text alignment to acAlignmentMiddleCenter

textObj.Alignment = acAlignmentMiddleCenter

'Create the text reference points

textObj.TextAlignmentPoint = CirinsPoint

 

'Create the Circle object

Set Cir = ThisDrawing.ModelSpace.AddCircle(CirinsPoint, CirRad)

 

'Save the drawing to the desktop

ThisDrawing.SaveAs ("C:\Documents and Settings\39925nt\Desktop\DS1000.dwg")

End Sub