|
|
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 |
|
置顶卡
