---

Dim_AltUnits.dvb.txt Dim_AltUnits_Test.dwg.txt

Moin zusammen!

Wir bekommen oft Zeichnungen mit Alternativeinhaiten bei den Bemaßungen.
Diese müssen wir oft auch entsprechend ergänzen, ändern und unserem Kunden zurückschicken.

Für unsere Fertigung sind diese Alternativeinheiten in den Zeichnungen weniger vorteilhaft.

Mittels VBA wollte ich mir mal "eben schnell" zwei Button hinzaubern,
um die Alternativeinheiten ein.- bzw. auszuschalten.

Dieses läuft auch soweit.
Die entsprechende Anzahl an Bemaßungen wird im Auswahlsat erfaßt, aber dann leider nur zum Teil abgeändert.
Kann mir jemand sagen, woran das liegt bzw. liegen könnte.

Code:

---

'------------------------------------------------------------------------
'########################################################################
'##--Die UserForm mit Inhalten füllen------------------------------------
Private Sub UserForm_Initialize()

With Me
    .Caption = "Alternativeinheit bei Bemaßungen Ein / Aus"
End With

With cmd_DimUnitsEin
    '.Picture = ImageList1.ListImages(2).Picture
    .PicturePosition = fmPicturePositionLeftBottom
    .Caption = "Ein"
End With

With cmd_DimUnitsAus
    '.Picture = ImageList1.ListImages(2).Picture
    .PicturePosition = fmPicturePositionLeftBottom
    .Caption = "Aus"
End With

End Sub
'------------------------------------------------------------------------
'########################################################################
'##--Ereignis beim Buttomclick auf ein-----------------------------------
Private Sub cmd_DimUnitsEin_Click()

'--Filterung--!!!
Dim DimObj As AcadEntity
Dim DimObj1 As AcadDimension
Dim DimType(0) As Integer
Dim DimData(0) As Variant
DimType(0) = 0: DimData(0) = "dimension"

'-------------------------------------------------------------
On Local Error Resume Next
'--Grundlagen für den Selectionsset Auswahlsatz--!!!
Dim DSet As AcadSelectionSet
Set DSet = ActiveDocument.SelectionSets.Add("Auswahl")
If Err <> 0 Then
    Set DSet = ActiveDocument.SelectionSets("Auswahl")
End If
'-----------------------------------------------------
'On Error Resume Next

    With DSet
        .Clear
        .Select acSelectionSetAll, , , DimType, DimData
    End With
   
Me.Caption = DSet.Count
   
For Each DimObj In DSet
    Set DimObj1 = DimObj
        DimObj1.AltUnits = True
        DimObj1.Update
Next DimObj

'Unload Me

End Sub

'------------------------------------------------------------------------
'########################################################################
'##--Ereignis beim Buttomclick auf aus-----------------------------------
Private Sub cmd_DimUnitsAus_Click()

'--Filterung--!!!
Dim DimObj As AcadEntity
Dim DimObj1 As AcadDimAligned
Dim DimType(0) As Integer
Dim DimData(0) As Variant
DimType(0) = 0: DimData(0) = "dimension"

'-------------------------------------------------------------
On Local Error Resume Next
'--Grundlagen für den Selectionsset Auswahlsatz--!!!
Dim DSet As AcadSelectionSet
Set DSet = ActiveDocument.SelectionSets.Add("Auswahl")
If Err <> 0 Then
    Set DSet = ActiveDocument.SelectionSets("Auswahl")
End If
'-----------------------------------------------------
'On Error Resume Next

    With DSet
        .Clear
        .Select acSelectionSetAll, , , DimType, DimData
    End With
   
Me.Caption = DSet.Count
   
For Each DimObj In DSet
    Set DimObj1 = DimObj
        DimObj1.AltUnits = False
        DimObj1.Update
Next DimObj

'Unload Me

End Sub

---

Für eine kurzfristige Hilfstellung wäre ich sehr dankbar.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Dirk,

Entferne erst einmal deine "On Local Error Resume Next" aus dem Code un schau mal, wo der dabei einen Fehler wirft.
Dann kann man weiter schauen,

Gruß, Carsten

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin Carsten!

Danke für den Tipp.
Der Fehler lag hier:

Code:

---

Private Sub cmd_DimUnitsAus_Click()

'--Filterung--!!!
Dim aDimObj As AcadEntity
'Dim aDimObj1 as AcadDimAligned /// dieses muß natürlich AcadDimension lauten!!!!
Dim aDimObj1 As AcadDimension
Dim aDimType(0) As Integer
Dim aDimData(0) As Variant
aDimType(0) = 0: aDimData(0) = "DIMENSION"

---

Nun läuft es prima.

Schönen Tag noch.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP