Visual Basic Customization

Visual Basic Customization

Reply
Distinguished Contributor
RafaelMoreno
Posts: 226
Registered: ‎11-06-2006
Message 1 of 3 (131 Views)

Attaching dimensions to a Dimension Style

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

 

 

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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 3 (129 Views)

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:

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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 3 of 3 (123 Views)

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
                    .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'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.