Hot News aus dem CAD.de-Newsletter:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Text von Bemaßungen auslesen VBA

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Text von Bemaßungen auslesen VBA (849 mal gelesen)
Sc1ssoR
Mitglied
Student


Sehen Sie sich das Profil von Sc1ssoR an!   Senden Sie eine Private Message an Sc1ssoR  Schreiben Sie einen Gästebucheintrag für Sc1ssoR

Beiträge: 26
Registriert: 11.04.2017

SolidWorks 16
VBA

erstellt am: 22. Jun. 2017 11:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

nahe
Mitglied



Sehen Sie sich das Profil von nahe an!   Senden Sie eine Private Message an nahe  Schreiben Sie einen Gästebucheintrag für nahe

Beiträge: 1393
Registriert: 18.01.2001

arbeite mit:
HP Z440 Workstation
Xenon (12-Kern) 3.5GHz
32GB RAM
238GB SSD
------------------------
SWX-2016 SP5.0
DBWorks-R15 SP2.17
----------------
Windows 7 64 bit
----------------
VB
VBA
Lotus Notes Datenbanken
erste Schritte mit Swift

erstellt am: 22. Jun. 2017 12:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Sc1ssoR 10 Unities + Antwort hilfreich

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

Sc1ssoR
Mitglied
Student


Sehen Sie sich das Profil von Sc1ssoR an!   Senden Sie eine Private Message an Sc1ssoR  Schreiben Sie einen Gästebucheintrag für Sc1ssoR

Beiträge: 26
Registriert: 11.04.2017

SolidWorks 16
VBA

erstellt am: 22. Jun. 2017 14:27    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

nahe
Mitglied



Sehen Sie sich das Profil von nahe an!   Senden Sie eine Private Message an nahe  Schreiben Sie einen Gästebucheintrag für nahe

Beiträge: 1393
Registriert: 18.01.2001

arbeite mit:
HP Z440 Workstation
Xenon (12-Kern) 3.5GHz
32GB RAM
238GB SSD
------------------------
SWX-2016 SP5.0
DBWorks-R15 SP2.17
----------------
Windows 7 64 bit
----------------
VB
VBA
Lotus Notes Datenbanken
erste Schritte mit Swift

erstellt am: 22. Jun. 2017 15:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Sc1ssoR 10 Unities + Antwort hilfreich

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

Sc1ssoR
Mitglied
Student


Sehen Sie sich das Profil von Sc1ssoR an!   Senden Sie eine Private Message an Sc1ssoR  Schreiben Sie einen Gästebucheintrag für Sc1ssoR

Beiträge: 26
Registriert: 11.04.2017

SolidWorks 16
VBA

erstellt am: 23. Jun. 2017 11:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Maschinenbautechniker



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

Beiträge: 2124
Registriert: 18.07.2012

HP Z400 Workstaion
CPU: Intel Xeon 6x 3,33GHz
GPU: NVIDEA Quadro 2000
RAM: 12 GB DDR3
Win 7 x64
CAD Hauptberuflich
-Solid Works 2014 SP4
-Creo Elements Direct Drafting (ME10)
DMS/PDM
-Pro.File V8 (8.4)
Simulation
-Simufact Forming 11.0
CAD Nebenberuflich
-Pro Engineer WF 3+4
-Creo Parametric 2.0

erstellt am: 26. Jun. 2017 07:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Sc1ssoR 10 Unities + Antwort hilfreich

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

Sc1ssoR
Mitglied
Student


Sehen Sie sich das Profil von Sc1ssoR an!   Senden Sie eine Private Message an Sc1ssoR  Schreiben Sie einen Gästebucheintrag für Sc1ssoR

Beiträge: 26
Registriert: 11.04.2017

SolidWorks 16
VBA

erstellt am: 27. Jun. 2017 10:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Maschinenbautechniker



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

Beiträge: 2124
Registriert: 18.07.2012

HP Z400 Workstaion
CPU: Intel Xeon 6x 3,33GHz
GPU: NVIDEA Quadro 2000
RAM: 12 GB DDR3
Win 7 x64
CAD Hauptberuflich
-Solid Works 2014 SP4
-Creo Elements Direct Drafting (ME10)
DMS/PDM
-Pro.File V8 (8.4)
Simulation
-Simufact Forming 11.0
CAD Nebenberuflich
-Pro Engineer WF 3+4
-Creo Parametric 2.0

erstellt am: 27. Jun. 2017 11:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Sc1ssoR 10 Unities + Antwort hilfreich

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

nahe
Mitglied



Sehen Sie sich das Profil von nahe an!   Senden Sie eine Private Message an nahe  Schreiben Sie einen Gästebucheintrag für nahe

Beiträge: 1393
Registriert: 18.01.2001

arbeite mit:
HP Z440 Workstation
Xenon (12-Kern) 3.5GHz
32GB RAM
238GB SSD
------------------------
SWX-2016 SP5.0
DBWorks-R15 SP2.17
----------------
Windows 7 64 bit
----------------
VB
VBA
Lotus Notes Datenbanken
erste Schritte mit Swift

erstellt am: 27. Jun. 2017 11:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Sc1ssoR 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2018 CAD.de | Impressum | Datenschutz