Making dimstyles by picking dimension line? Ver 2008 VBA

[muck]

Subject: Making dimstyles by picking dimension line? Ver 2008 VBA

 

If you look at the pdf attachment you will see

various dim object variables for a choosen dimension

line. See file and code.

 

Is there a way to step thur the dimension object

and set variables for a new dim style?????

 

Is there a way to make a dimstyle from all (or most) of these

variables to best match the dimstyle that created the

my picked dimension?

 

I can change a few object variables individually but how can

I get a complete best match dim style from the choose

dimension?

 

 

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

 

 

 

'Annotation Text

 

 

 

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

 

 

 

 

 

 

 

Thank you,

DimObjects.pdf