• На форуме с 30 октября 2006г.
  • Сообщений: 70
  • Спасибо: 0

Тема: Как отключить ассоциативность размеров (лучше на VBA)

Какое свойство в объекте размера отвечает за его ассоциативность? Помогите отключить ассоциативность размеров, потому что при перемещении объектов ассоциативные размеры начинают привязываться непонятно к каким точкам и весь чертёж портится.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Как отключить ассоциативность размеров (лучше на VBA)

> Миша
Ассоциативность хранится в расширенном словаре
примитива, надо чисtиtь словарь
Немного коду для размышления:

Option Explicit
' by Fatty T.O.H ()2007 * all rights removed
' check on dimension associativity
Function IsDimAssoc(ByVal oDim As AcadDimension) As Boolean
     Dim oDict As AcadDictionary
     Dim itmDict As AcadObject
     On Error Resume Next
     If oDim.HasExtensionDictionary = False Then
          IsDimAssoc = False
     Else
          Set oDict = oDim.GetExtensionDictionary
          For Each itmDict In oDict
               If itmDict.ObjectName = "AcDbDimAssoc" Then
                    IsDimAssoc = True
                    Exit For
               End If
          Next
     End If
End Function
' Reassociate dimension
Private Sub RemoveAssoc(ByVal oDim As AcadDimension)
     Dim oDict As AcadDictionary
     Dim itmDict As AcadObject
     On Error Resume Next
     If oDim.HasExtensionDictionary = False Then
          Exit Sub
     Else
          Set oDict = oDim.GetExtensionDictionary
          For Each itmDict In oDict
               If itmDict.ObjectName = "AcDbDimAssoc" Then
                    itmDict.Delete
                    Exit For
               End If
          Next
     End If
End Sub
' test on dimension associativity
Sub test1()
     Dim oEnt As AcadEntity
     Dim varPt
     Dim check As Boolean
     Dim objDim As AcadDimension
     On Error GoTo Err_Control
     ThisDrawing.Utility.GetEntity oEnt, varPt, "Select dimension"
     If TypeOf oEnt Is AcadDimension Then
          Set objDim = oEnt
          check = IsDimAssoc(objDim)
     End If
     MsgBox "Associativity: " & check
Err_Control:
End Sub
' remove associativity from dimension object
Sub test2()
     Dim oEnt As AcadEntity
     Dim varPt
     Dim check As Boolean
     Dim objDim As AcadDimension
     On Error GoTo Err_Control
     ThisDrawing.Utility.GetEntity oEnt, varPt, "Select dimension"
     If TypeOf oEnt Is AcadDimension Then
          Set objDim = oEnt
          check = IsDimAssoc(objDim)
          If check = True Then
          RemoveAssoc objDim
          End If
     End If
     objDim.Update
     MsgBox "Now associativity is: " & IsDimAssoc(objDim)
Err_Control:
End Sub

~'J'~