VBA, Using Objdimsension to make a dimstyle

[muck]

AutoCAD 2009 VBA

 

I have been using the following code to pick a

dimension variable in Objdimsension. Then I set my

specific autoCAD variable.

Is it possable to modify this code to pick my

dimension then create & save a dimstyle using all the

variables in objdimension object. Maybe I could loop

thru objdimension then set variables in my

dimstyle object. Does anyone have a sample of this?

 

Code:

Private Sub CommandButton2_Click()

Dim objDimension As AcadDimension

Dim varPickedPoint As Variant

Dim objDimStyle As AcadDimStyle

Dim strDimStyles As String

Dim strChosenDimStyle As String

Dim stg As String

 

On Error Resume Next

Me.hide

ThisDrawing.Utility.GetEntity objDimension, varPickedPoint, _

"Picked a dimension whose style you wish to set"

If objDimension Is Nothing Then

MsgBox "You failed to pick a dimension object"

Exit Sub

End If

stg = "Textheight"

 

'MsgBox objDimension.TextRotation

'ThisDrawing.SetVariable "CLAYER",

 

objDimension.DimensionLinelayer

 

MsgBox objDimension.ExtensionLineExtend

ThisDrawing.SetVariable "dimexe",

 

objDimension.ExtensionLineExtend

MsgBox objDimension.ExtensionLineOffset

ThisDrawing.SetVariable "dimexo",

 

objDimension.ExtensionLineOffset

 

MsgBox objDimension.Layer

ThisDrawing.SetVariable "CLAYER",

 

objDimension.DimensionLinelayer

 

MsgBox objDimension.DimensionLineColor

ThisDrawing.SetVariable "DIMCLRD",

 

objDimension.DimensionLineColor

 

MsgBox objDimension.ExtensionLineColor

ThisDrawing.SetVariable "DIMCLRE",

 

objDimension.ExtensionLineColor

MsgBox objDimension.color

'Dim text color

ThisDrawing.SetVariable "DIMCLRT", objDimension.color

 

MsgBox objDimension.ScaleFactor

ThisDrawing.SetVariable "Dimscale", objDimension.ScaleFactor

ThisDrawing.SendCommand "Dimscale" & vbCr

ThisDrawing.SendCommand objDimension.ScaleFactor & vbCr

 

MsgBox objDimension.VerticalTextPosition

ThisDrawing.SetVariable "DIMTAD",

 

objDimension.VerticalTextPosition

 

MsgBox objDimension.TextHeight

ThisDrawing.SetVariable "DIMTXT", objDimension.TextHeight

 

 

'****Text Style

MsgBox objDimension.TextStyle

'ThisDrawing.SetVariable "DIMTXT", objDimension.TextHeight

ThisDrawing.DimStyles.StyleName , objDimension.TextStyle

 

MsgBox objDimension.TextGap

ThisDrawing.SetVariable "DIMJUST", objDimension.TextGap

 

MsgBox objDimension.ArrowheadSize

ThisDrawing.SetVariable "DIMASZ", objDimension.ArrowheadSize

 

Set objDimStyle = ThisDrawing.DimStyles.Add("YourNamedStyle")

objDimStyle.CopyFrom ThisDrawing

ThisDrawing.ActiveDimStyle = objDimStyle

'Make your changes here....................

objDimStyle.CopyFrom ThisDrawing

'"YourNameStyle"

objDimStyle.Name = "YourNamedStyle"

End Sub