---

Hallo,

ich möchte ein Makro erstellen welches die Bemaßungen überprüft, sodass zb bei einem Maß 40 nicht im Suffix ,5 und somit das Maß auf 40,5 angezeigt wird. Solche Fehler muss ich erkennen und aufzeigen. Daher muss ich den Prefix und den Suffix lesen können.
Bei Zeichnungen geht das wie folgt:

Code:

---

[/CODE]
Set swDispDim = swView.GetFirstDisplayDimension5
    Do While Not swDispDim Is Nothing
        Set swAnn = swDispDim.GetAnnotation
        Set swDim = swDispDim.GetDimension
            Debug.Print "    ------------------------------------"
            Debug.Print "      AnnName                      = " & swAnn.GetName
            Debug.Print "      DimFullName                  = " & swDim.FullName
            Debug.Print "      DimName                      = " & swDim.Name
            Debug.Print "      swDimensionParamType_e type  = " & swDim.GetType
            Debug.Print "      DrivenState                  = " & swDim.DrivenState
            Debug.Print "      ReadOnly                    = " & swDim.ReadOnly
            Debug.Print "      Value                        = " & swDim.GetSystemValue2("")
            Debug.Print ""
            Debug.Print "      Arrowside                    = " & swDispDim.ArrowSide
            Debug.Print "      TextAll                      = " & swDispDim.GetText(swDimensionTextAll)
            Debug.Print "      TextPrefix                  = " & swDispDim.GetText(swDimensionTextPrefix)
            Debug.Print "      TextSuffix                  = " & swDispDim.GetText(swDimensionTextSuffix)
            Debug.Print "      CalloutAbove                = " & swDispDim.GetText(swDimensionTextCalloutAbove)
            Debug.Print "      CalloutBelow                = " & swDispDim.GetText(swDimensionTextCalloutBelow)
[CODE]

---

allerdings muss ich das selbe für Part Dateien machen und daliegt auch das Problem.
Wie komme ich an den Part Dateien an die Pre- und Suffixe der einzelnen Skizzen?

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

---

Hallo,

ich würd es mal mit "GetTextFormatItems" versuchen

lt. Onlinehilfe

Dim tokenformats As Variant
Dim tokenvalues As Variant

swDispDim.GetTextFormatItems( swDimensionTextParts_e.swDimensionTextSuffix, tokenformats, tokenvalues)

------------------
Grüße
Heinz

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

---

danke für die Antwort.

bei mir wählt er die Zeile an und wirft "Objectvariable nicht festgelegt..." aus.

muss ich swDispDim vorher noch anders deklarieren?

so ist es mit einer Zeichnung definiert
Set swDispDim = swView.GetFirstDisplayDimension5
also brauch ich ja nur das swView für Parts, oder?

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

---

Hallo

da hab ich scheinbar was überlesen, in Deinem ersten Posting.
In einer Teile-Datei hast Du natürlich keine Views wie in einer Zeichnung.
Da musst Du die Features durchlaufen und die Maße der Features untersuchen.

Schlag Dich doch mal etwas mit der Online-Hilfe etwas herum,
da findest Du auch etliche Beispiele
zum Thema Features und Bemaßungen in einem Teil durchlaufen
z.B.:
Set Dimensions to Mid-Tolerance Example (VBA)

------------------
Grüße
Heinz

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

---

Vielen Dank funktioniert soweit!
Code sieht jetzt wie folgt aus:

Code:

---

If swTyp = "1" Then
    Set Feature = swmodel.FirstFeature
    Do While Not Feature Is Nothing
        Set swDispDim = Feature.GetFirstDisplayDimension
        Do While Not swDispDim Is Nothing
            Set swDim = swDispDim.GetDimension
            swDispDim.GetTextFormatItems swDimensionTextParts_e.swDimensionTextPrefix, tokenformats, tokenvalues
            swDispDim.GetTextFormatItems swDimensionTextParts_e.swDimensionTextSuffix, tokenformats2, tokenvalues2
            Set swDispDim = Feature.GetNextDisplayDimension(swDispDim)
'Prefix Zusammenstellen
On Error Resume Next
    Prefix0 = tokenvalues(0)
    If Err.Number <> 0 Then
        Prefix0 = ""
    End If
On Error Resume Next
    Prefix1 = tokenvalues(1)
    If Err.Number <> 0 Then
        Prefix1 = ""
    End If
    Prefix = Prefix0 & Prefix1
'Suffix Zusammenstellen
On Error Resume Next
    Suffix0 = tokenvalues2(0)
    If Err.Number <> 0 Then
        Suffix0 = ""
    End If
On Error Resume Next
    Suffix1 = tokenvalues2(1)
    If Err.Number <> 0 Then
        Suffix1 = ""
    End If
    Suffix = Suffix0 & Suffix1
    Loop
    Set Feature = Feature.GetNextFeature
    Loop
End If

---

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

---

Hallo,

ich sehe in deinem Code jetzt nur Pre- und Suffix, überprüfst du auch ob der Bemaßungswert einfach übergangen wurde, was wohl eher vorkommt wie eine Zahl einfach dahinter / davor zu schreiben.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hi Bernd,

da ich mit meinem Makro im Anschluß den DesignChecker in SW starte und in diesem prüfe ob das Maß übergangen wurde, ist das auch abgedeckt.
Mit der Prefix und Suffix Kontrolle ergänze ich sozusagen den DesignChecker um zusätzliche Funktionen.

Die Kontrolle etc Funktioniert soweit einwandfrei allerdings habe ich ein Problem durch das Makro Word anzusprechen.

Zur Erläuterung:
-Ich kontrolliere Prefix sowie Suffix und Zähle wie oft der jeweilige Fehler auftritt
-Designchecker wird durchlaufen
-der DesignChecker wirft ein Report aus, welches in .xml oder .doc ausgegeben werden kann
-meine gefundenen Fehler im Pre-/ Suffix füge ich dem Report mit der Anzahl bei

das alles Funktioniert gut, aber nur wenn ich Word schon geöffnet habe

ich öffne Word durch Set wdApp = Word.Application
wenn nun Word noch nicht geöffnet war entsteht der Fehler:
"Objecterstellung durch ActiveX- Komponente nicht möglich"

ich arbeite mit Office 2010, 64 bit

-bis jetzt habe ich mit der CDO.dll kein Erfolg gehabt.
-durch einen Workaround mit

Code:

---

Dim strDatei1 As String
    strDatei1 = "S:\Bachelorarbeit\DsgnChkResult\DCresult\SWDCReport.doc"
Dim wordbasic As Object
Dim wb As Object
If wordbasic Is Nothing Then
'Set wordbasic = GetObject(strDatei1)
Set wb = wordbasic.Parent
Set wdApp = wb

---

bin ich auf die Kompatibilitäts Version von Word gekommen die auch ohne Probleme läuft.
Allerdings nur beim ersten mal. Beim erneuten Starten erscheint die Fehlermeldung in der Zeile mit GetObject.
"Datei- oder Klassenname während Automatisierungsoperation nicht gefunden"

-die .xml Datei hat eine .xsl zugrunde und der Quellcode von dieser beinhaltet nur Chiniesische Schriftzeichen. Also kann ich den auch nicht wirklich bearbeiten.

Weiß einer weiter? 

[Diese Nachricht wurde von Sc1ssoR am 27. Jun. 2017 editiert.]

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

---

Hallo,

hast du es mal mit CreateObject versucht

Code:

---

Dim appWD As Word.Application

Set appWD = CreateObject("Word.Application")
appWd.Visible = True

---

Zu finden auf der MSDN-Seite Hier entlang, auf dieser Seite gibt es auch noch weitere Infos zum ansprechen von Office Produkten.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

---

Hallo

der folgende Ansatz gefällt mir noch besser, weil zuerst geprüft wird
ob die Applikation bereits geöffnet ist
(kann aber auch Nachteile haben, weil es sein könnte, das die Applikation gerade in einem Befehl steckt)

anbei das Beispiel an Hand von Excel

  On Error Resume Next
  ' Versuch einen Verweis auf Excel zu bekommen
  Set excel = GetObject(, "Excel.Application")
  ' Wenn ein Fehler auftritt dann läuft Excel noch nicht
  If Err.Number <> 0 Then excel_NOK = True
  Err.Clear
  ' Wenn Excel noch nicht läuft, dann wird es gestartet
  If excel_NOK = True Then
    Set excel = CreateObject("excel.application")
  End If
   
  excel.Visible = True

------------------
Grüße
Heinz

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