Attaching dimensions to a Dimension Style

[RalphBrown99]

Hi:

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

'

'

Next

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

Rafael

[Hallex]

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:

acdimRot.Style="myNewStyle"

else if Typeof  objDimension is AcadDimAligned then

dim acDimAlign as AcabDimAlignedDimension

set acDimAlign=objDimension

acDimAlign.Style="myNewOtherStyle"

Next

ETC,

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

digg deeper inside all dimension types then,

~'J'~

[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
                    .SelectionSets.Item(setName).Delete
                    Exit For
               End If
          Next
          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
        acDimRot.Update
        ElseIf TypeOf oDim Is AcadDimAligned Then
        Dim acDimAlign As AcadDimAligned
        Set acDimAlign = oDim
        acDimAlign.styleName = stName
        acDimAlign.Update
         ElseIf TypeOf oDim Is AcadDimDiametric Then
        Dim acDimDia As AcadDimDiametric
        Set acDimDia = oDim
        acDimDia.styleName = stName
        acDimDia.Update
        ElseIf TypeOf oDim Is AcadDimRadial Then
        Dim acDimRad As AcadDimRadial
        Set acDimRad = oDim
        acDimRad.styleName = stName
        acDimRad.Update
        
        'ElseIf TypeOf oDim Is ETC...
        'Else ...
        
        End If
        
    Next
    ThisDrawing.Regen acActiveViewport
Err_Control:
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
   Next
End Function

~'J'~