Visual Basic Customization

Visual Basic Customization

Distinguished Contributor
231 Posts
1 Kudo
Registered: ‎11-06-2006
Post 1 of 3

Attaching dimensions to a Dimension Style

136 Views, 2 Replies
08-02-2012 12:09 PM





I have a group of dimension objects gather up by a selection set (objSS). I can screen each one one of these dimension by the lines


Dim objDimStyle As AcadDimStyle



For Each objDimension In objSS





How is possible to assign the property Dim Style to each one of my objDimension to an Style that I have already created?


I can not find this property available for my objDimension


Thanks in advance




*Expert Elite*
1,569 Posts
171 Kudos
Registered: ‎10-08-2008
Post 2 of 3

Re: Attaching dimensions to a Dimension Style

08-02-2012 01:41 PM in reply to: RafaelMoreno

Cast objects explicitly, always

Dim oEnt as AcadEntity

dim objDimension as AcadDimension


For Each oEnt In objSS

set  objDimension=oent

If Typeof  objDimension is AcadDimRotated then

dim acDimRot as AcadDimRotatedDimension

set acDimRot=objDimension

'then something similar:


else if Typeof  objDimension is AcadDimAligned then

dim acDimAlign as AcabDimAlignedDimension

set acDimAlign=objDimension






Sorry, Just from the top of my head without VBA Editor,

digg deeper inside all dimension types then,



*Expert Elite*
1,569 Posts
171 Kudos
Registered: ‎10-08-2008
Post 3 of 3

Re: Attaching dimensions to a Dimension Style

08-02-2012 02:38 PM in reply to: Hallex

well, here is the code, see how it works for you


Option Explicit

Public Sub ch_dimstyle()
     Dim gpCode(0) As Integer
     Dim dataValue(0) As Variant
     Dim dxfcode, dxfdata
     Dim oEnt As AcadEntity
     Dim oDim As AcadDimension
     Dim setObj As AcadSelectionSet
     Dim setColl As AcadSelectionSets
     Dim setName As String
     Dim objEnt As AcadEntity
     Dim stName As String
     stName = "MyNewDimStyle"
     If Not IsDimStyleExist(stName) Then
     MsgBox "Dimstyle does not exist, create one before..."
     Exit Sub
     End If
          On Error GoTo Err_Control
         gpCode(0) = 0: dataValue(0) = "DIMENSION"

       dxfcode = gpCode: dxfdata = dataValue
     setName = "$DIMENSION$"

     With ThisDrawing
          Set setColl = .SelectionSets
          For Each setObj In setColl
               If setObj.Name = setName Then
                    Exit For
               End If
          Set setObj = .SelectionSets.Add(setName)
     End With

     setObj.SelectOnScreen dxfcode, dxfdata
     setObj.Highlight True
     MsgBox "Selected: " & CStr(setObj.Count) & " objects"
 For Each oEnt In setObj
 Set oDim = oEnt
        If TypeOf oDim Is AcadDimRotated Then
        Dim acDimRot As AcadDimRotated
        Set acDimRot = oDim
        acDimRot.styleName = stName
        ElseIf TypeOf oDim Is AcadDimAligned Then
        Dim acDimAlign As AcadDimAligned
        Set acDimAlign = oDim
        acDimAlign.styleName = stName
         ElseIf TypeOf oDim Is AcadDimDiametric Then
        Dim acDimDia As AcadDimDiametric
        Set acDimDia = oDim
        acDimDia.styleName = stName
        ElseIf TypeOf oDim Is AcadDimRadial Then
        Dim acDimRad As AcadDimRadial
        Set acDimRad = oDim
        acDimRad.styleName = stName
        'ElseIf TypeOf oDim Is ETC...
        'Else ...
        End If
    ThisDrawing.Regen acActiveViewport
If Err.Number <> 0 Then
    MsgBox Err.Description
    End If
End Sub
Function IsDimStyleExist(styleName As String) As Boolean
IsDimStyleExist = False
Dim oDimSt As AcadDimStyle
On Error Resume Next
   For Each oDimSt In ThisDrawing.DimStyles
   If StrComp(oDimSt.Name, styleName, vbTextCompare) = 0 Then
   IsDimStyleExist = True
   Exit For
   End If
End Function



Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Are you interested in helping shape the future of the Autodesk Community? To participate in this brief usability study, please click here. Your time and input is greatly appreciated!