---

Hallo zusammen,

ich habe mir ein Makro anhand verschiedener Quellen zusammengebastelt.
Soweit funktioniert alles, nur die Ausgabe könnte wesentlich praktikabler sein.

Das Makro sucht mir alle Flächen mit dem Namen 1_Querschnitt... und 2_Querschnitt... der angezeigten Querschnittsflächen (verformtes Rohr) und gibt mir dessen Flächeninhalte in der MsgBox einzeln aus:

Sub CATMain()

Dim Language as String

Language="VBScript"

Dim partDocument1 As PartDocument

Set partDocument1 = CATIA.ActiveDocument

Set part1 = CATIA.ActiveDocument.Part

Set hybridShapeFactory1 = part1.HybridShapeFactory

Set hybridShapeFill1 = hybridShapeFactory1.AddNewFill()

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Querschnittsanalyse")

Dim selection1 As Selection

Set selection1 = partDocument1.Selection

selection1.Search "Name=1_Querschnitt*,Bild"

Dim TheSPAWorkbench As Workbench

Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench ( "SPAWorkbench" )

Dim TheMeasurable As Measurable

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

MsgBox (TheMeasurable.Area)  + Name

part1.Update

Next

selection1.Search "Name=2_Querschnitt_nahe*,Bild"

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

MsgBox (TheMeasurable.Area)

Next

End Sub

Ich benötige jedoch nur die Ausgabe von dem maximalen Querschnitt und dem minimalen Querschnitt und den Namen des jeweiligen Querschnitts (sind jetzt jedes mal ca. 30-150 Querschnitte insgesamt zum Durchklicken ohne Namensausgabe...) Hier stehe ich nun an, ich hoffe es kann mir hier jemand von euch evtl. weiterhelfen.

Lg Jan

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

---

Hallo Jan,

wie machst Du's bisher? Durchklicken und max/min merken/aufschreiben?
Wie entscheidest Du, welche Werte Du aufschreiben/merken musst?

Pseudo-Code:

Falls A_Neu > A_Max dann A_Max = A_Neu

Falls A_Neu < A_Min dann A_Min = A_Neu

Um für jede Deiner Schleifen den max/min Wert zu ermitteln, baust Du  zwei If / EndIf-Abfragen ein. Eine für den Maximalwert und eine für min.
Nachdem die Schleife abgearbeitet wurde, gibst Du das Ergebnis per
MsgBox aus, zB:

MsgBox "Max. Wert: " & A_max & vbCrLf & "Min. Wert: " & A_min

Je Schleife müsstest Du zwei Variable für A_Max/Min anlegen, etwa

Dim dblA_Max1
Dim dblA_Min1
Dim dblA_Max2
Dim dblA_Min2

Falls Du den Namen auch noch brauchst, legst eben auch dafür eine Var an, zB:
Dim strNameMax1
Dim strNameMin1
Dim strNameMax2
Dim strNameMin2

Die For/Next - Schleife sieht dann so aus:

Code:

---

For ....
  If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = Name
  ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
  EndIf
Next
MsgBox "Max. Wert: " & dblA_max1 & vbTab & strNameMax1 & vbCrLf _
  & "Min. Wert: " & dblA_min1 & vbTab & strNameMin1

---

Für die zweite Schleife machst Du's entsprechend.

Ausserdem:

- Wo definierst Du die Variable 'Name'?
- 'Name' als Variablenbezeichner zu verwenden ist nicht gut. Name wird unter VB als Property-Bezeichner verwendet.
- Schau Dir in der VBA-Oberfläche die Online-Hilfe zu Entscheidungsstrukturen ('If Then Else' und 'Select Case') an
- am besten auch noch die 'Constant and Variable Naming Conventions'.

Hope it helps.
Joe

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

---

Hallo Joe,

ich habe das Makro erst seit kurzem in Verwendung und habe die Werte gerundet mitgeschrieben (2-Stellig) ist jedoch eben sehr umständlich.
Den Namen bräuchte ich vom gemessenen Querschnitt. Die Erstellung der Querschnitte habe ich schon über ein anderes Makro bewältigt und die Querschnitte werden als Füllung (die ich mit diesem Makro ja vermesse) automatisiert ausgegeben und fortlaufend nummeriert (Querschnitt1, Querschnitt2, usw.). Also müsste ich doch den Namen der gerade vermessenen Fläche (z.B. Querschnitt12) verwenden können bzw. einen neuen Namen erstellen können, da die Nummerierung meines Erachtens nach parallel dazu ablaufen würde.

Ich glaube mit deinen Schleifen sind wir schon auf der Zielgeraden, ich bekomme es nur nicht hin, sie einzubauen (Catia mag das EndIf nicht)
=> End If    habs lang nicht gecheckt^^

...Nach meiner Logik müsste ich doch den ersten Wert separat messen (als Basis) und die nachher gemessene Werte mit deinen Schleifen vergleichen, oder liege ich da falsch?
Bzw. wie würde das Makro mit eingebauten Schleifen ausschauen?

=> Ich musste es für den Min-Wert doch trennen, da ansonsten der Ausgangswert, also "nichts" der kleinste geblieben wäre.

Ansonsten funktionieren die Schleifen Super    Danke 

Nur das mit den Namen haut noch nicht hin.
Vielleicht weißt du hier doch noch einen Rat, da blicke ich noch nicht ganz durch...

Vielen Dank für deine Hilfe!  
Lg Jan

Hier noch das derzeitige Makro:

Sub CATMain()

Dim Language as String

Language="VBScript"

Dim partDocument1 As PartDocument

Set partDocument1 = CATIA.ActiveDocument

Set part1 = CATIA.ActiveDocument.Part

Set hybridShapeFactory1 = part1.HybridShapeFactory

Set hybridShapeFill1 = hybridShapeFactory1.AddNewFill()

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Querschnittsanalyse")

Dim selection1 As Selection

Set selection1 = partDocument1.Selection

selection1.Search "Name=1_Querschnitt*,Bild"

Dim TheSPAWorkbench As Workbench

Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench ( "SPAWorkbench" )

Dim TheMeasurable As Measurable

Dim dblA_Max1
Dim dblA_Min1
Dim dblA_Max2
Dim dblA_Min2

Dim strNameMax1
Dim strNameMin1
Dim strNameMax2
Dim strNameMin2

For i  = 1 TO 2

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

Next

For i  = 2 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

next

selection1.Search "Name=2_Querschnitt_nahe*,Bild"

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

Next

MsgBox "Max. Wert: " & dblA_max1 & vbTab & strNameMax1 & vbCrLf _
& "Min. Wert: " & dblA_min1 & vbTab & strNameMin1

End Sub

[Diese Nachricht wurde von Tube3 am 27. Nov. 2014 editiert.]

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

---

Servus Jan
Joes Code könntest du jeweils in die For-Next-Schleife der beiden Messungen einbauen.
Den jeweiligen Namen des gemessenen Elements könntest du über:

Code:

---

name = selection1.Item(i).Name

---

oder

Code:

---

name = selection1.Item(i).Value.Name

---

bekommen.
AFAIR muss es statt "EndIf" "End If" heißen

Gruß
Bernd

PS: Bitte Systeminfo ergänzen.

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

@ Bernd

'AFAIR muss es statt "EndIf" "End If" heißen'

Klar.

@ Jan

'Ich musste es für den Min-Wert doch trennen, da ansonsten der Ausgangswert, also "nichts" der kleinste geblieben wäre.'

Ja, stimmt. Müsstest halt dblA_Min zunächst auf irgendeinen (viel zu grossen) Ausgangswert setzen.

Ich hab die Routine freihändig geschrieben, also nicht ausgetestet.

Tschau,
Joe

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

---

Hallo Bernd,

auf das End if bin auch gerade draufgekommen^^

Mit name = selection1.Item(i).Value.Name funktioniert es Einwandfrei.

@ Joe

Einen Startwert zu vergeben hab ich nicht hinbekommen, aber so wie es jetzt oben steht funktioniert das Makro ja auch einwandfrei.
Mit der Ergänzung von Bernd bleibt nun auch kein Wunsch mehr offen.

Vielen Dank euch beiden!   

[Diese Nachricht wurde von Tube3 am 27. Nov. 2014 editiert.]

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

---

@ Bernd

Systeminfo ist jetzt auch ergänzt  

[Diese Nachricht wurde von Tube3 am 27. Nov. 2014 editiert.]

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

---

Hallo Jan,

mit einen Ausgangswert setzen  meinte ich:

dblA_Min = 'sehr grosser Wert'

also, wenn zB Werte zwischen 100  und 1000 normal wären

dblA_Min1 = 1000
For ...

Next

Dann würde (wahrscheinlich) jeder gemessene Wert darunter liegen und somit zum neuen dblA_Min werden.

Tschau,
Joe

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

---

Hallo Jan,

ich hab das Makro grad noch mal angeschaut. Ich würd's so schreiben:
Statt:

Code:

---

For i  = 1 TO 2

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

Next

For i  = 2 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

next

selection1.Search "Name=2_Querschnitt_nahe*,Bild"

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = Name
End If

Next

MsgBox "Max. Wert: " & dblA_max1 & vbTab & strNameMax1 & vbCrLf _
& "Min. Wert: " & dblA_min1 & vbTab & strNameMin1

---

würde ich

Code:

---

dblA_Min1 = 10000  'der wert muss grösser als _alle_ zu erwartenden sein

For i  = 1 TO selection1.Count

  Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

  If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = selection1.Item(i).Name
  ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = selection1.Item(i).Name
  End If
next

selection1.Search "Name=2_Querschnitt_nahe*,Bild"

dblA_Min2 = 10000  'der wert muss grösser als _alle_ zu erwartenden sein

For i  = 1 TO selection1.Count

  Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

  If TheMeasurable.Area > dblA_Max2 then
      dblA_Max2 = TheMeasurable.Area
      strNameMax2 = selection1.Item(i).Name
  ElseIf TheMeasurable.Area < dblA_Min2 then
      dblA_Min2 = TheMeasurable.Area
      strNameMin2 = selection1.Item(i).Name
  End If
Next

MsgBox "Max. Wert 1: " & dblA_max1 & vbTab & strNameMax1 & vbCrLf _
& "Min. Wert 1: " & dblA_min1 & vbTab & strNameMin1
MsgBox "Max. Wert 2: " & dblA_max2 & vbTab & strNameMax2 & vbCrLf _
& "Min. Wert 2: " & dblA_min2 & vbTab & strNameMin2

---

Du bekommst jetzt für jede Schleife/Selection zwei Werte mit zwei Namen.

Tschau,
Joe

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

---

Hallo Jan,

die von mir vorgeschlagene Initialisierung von dblA_Min ist noch nicht optimal.
Besser wäre einfach einen Wert aus der Selection zuzuweisen, also zB.

dblA_Min1 = TheSPAWorkbench.GetMeasurable(selection1.Item(1).Reference).Area

Warum? Erstens ist dann der Anfangswert (wahrscheinlich) nicht null, zweitens stimmt der Wert auch noch von der Größenordnung her garantiert, was bei der anderen Lösung nicht der Fall war.

Was mir auch noch klar geworden ist: Du willst offenbar nur ein Wertepaar max/min.
Demzufolge sind die Variablen dblA_Min2, dblA_Max2, strNameMax2 und strNameMin2 überflüssig  und können gelöscht werden.
Schlussendlich: Wenn es Dir gelingt die beiden Suchläufe zu kombinieren, kommst Du mit einer Schleife aus.

Der Suchstring für alle Drafting-Linien mit Namen Line* sowie alle Drafting-Texte mit Namen Text* sieht so aus:
(Name=Text* & (Drafting.Text + (Name=Line* & Drafting.Line)));all

Wichtig ist, dass Du die beiden suchen mit 'oder'(or) verknüpfst.

Dein Suchstring müsste ungefähr so aussehen:

Name=1_Querschnitt* + Name=2_Querschnitt_nahe*,all

Die genaue Syntax und ob und wo da noch Klammern oder/und Anführungszeichen hinkommen, musst ausprobieren, eventuell erst mal interaktiv.

Ich hoffe, ich hab Dich jetzt nicht zu sehr verwirrt.

Joe

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

---

Hallo Joe,

ich brauche nur einen Min- und einen Max-, da die Auswertung die Gruppe der Verschneidungen und die Verschneidungen, die durch den Befehl "Nahe" ausgegeben werden, umfasst (sind aber somit nur alle Verschneidungen eines Rohres). Aber den Part "dblA_Min1 = 10000" habe ich jetzt so übernommen. Danke dir  

Ich wollte die Werte die nun in m² ausgegeben werden gerundet auf eine Kommastelle in cm² ausgeben durch:

Dim dblA_Max1_Step1
Dim dblA_Min1_Step1
Dim dblA_Max1_Qcm
Dim dblA_Min1_Qcm

Set dblA_Max1_Step1 = dblA_Max1 * 100000
Set dblA_Min1_Step1 = dblA_Min1 * 100000

Func CInt (dblA_Max1_Step1) As Integer
Func CInt (dblA_Min1_Step1) As Integer

Set dblA_Max1_Qcm = dblA_Max1_Step1 / 10
Set dblA_Min1_Qcm = dblA_Max1_Step1 /10

also die m² mal 100000, gerundet und wieder durch 10 dividiert um auf den richtigen Umrechnungsfaktor zu kommen und eine Kommastelle gerundet zu behalten.

Jetzt meckert er aber bei "Set dblA_Max1_Step1 = dblA_Max1 * 100000", dass er ein Objekt benötigt...

Muss ich hier noch etwas ergänzen?

Lg Jan

[Diese Nachricht wurde von Tube3 am 28. Nov. 2014 editiert.]

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

---

Servus
Lass in der Zeile mal das "Set" weg.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hallo Jan,

war mal ein paar Stunden AFK.
------------------------------
Nein; was weglassen.

Nachdem dblA_Max1_Step1 kein Object ist, sondern eine Variable, kannst auch das 'Set' weglassen.

Kurz zu der von mir meistens verwendeten Nomenklatur:

Prefix 

- dbl          double (Zahlenwerte doppelter Genauigkeit)
- i oder int   integer (Bereich -32768 bis + 32767)
- l            long integer (-2147483648 bis +2147483647)
- str          string
- b            boolean

Zu CInt: das ist eine in VB eingebaute Funktion. Die brauchst nicht noch mal deklarieren. Was Du hier aber eher brauchen würdest ist CLng.

Um einen Wert vom Typ 'double' umzurechnen und auf eine Dezimale auszugeben, würde ich entweder

"Qcm_M..= "& format(dblA_M.._Step1 * 10000,"0.0")

oder

dblA_M.._Qcm = round(dblA_M.._Step1 * 10000,1)

verwenden.
Die 6 bisherigen Code-Zeilen kannst dann löschen.

Für's Selbststudium: Online Hilfe zu 'Data Type Summary'

Tschau,
Joe

[Diese Nachricht wurde von joehz am 30. Nov. 2014 editiert.]

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

---

Hallo,

so einfach kann es sein...^^ Danke dir Bernd  

Lg Jan

Es funktioniert jetzt alles wie am Schnürchen.

Falls jemand etwas ähnliches vorhat, hier noch das fertige Makro:

Sub CATMain()

Dim Language as String

Language="VBScript"

Dim partDocument1 As PartDocument

Set partDocument1 = CATIA.ActiveDocument

Set part1 = CATIA.ActiveDocument.Part

Set hybridShapeFactory1 = part1.HybridShapeFactory

Set hybridShapeFill1 = hybridShapeFactory1.AddNewFill()

Set hybridBodies1 = part1.HybridBodies

Set hybridBody1 = hybridBodies1.Item("Querschnittsanalyse")

Dim selection1 As Selection

Set selection1 = partDocument1.Selection

selection1.Search "Name=1_Querschnitt*,Bild"

Dim TheSPAWorkbench As Workbench

Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench ( "SPAWorkbench" )

Dim TheMeasurable As Measurable

Dim dblA_Max1
Dim dblA_Min1

Dim strNameMax1
Dim strNameMin1

dblA_Min1 = 10000 

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = selection1.Item(i).Value.Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = selection1.Item(i).Value.Name
End If

next

selection1.Search "Name=2_Querschnitt_nahe*,Bild"

For i  = 1 TO selection1.Count

Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selection1.Item(i).Reference)

If TheMeasurable.Area > dblA_Max1 then
      dblA_Max1 = TheMeasurable.Area
      strNameMax1 = selection1.Item(i).Value.Name
ElseIf TheMeasurable.Area < dblA_Min1 then
      dblA_Min1 = TheMeasurable.Area
      strNameMin1 = selection1.Item(i).Value.Name
End If

Next

Dim dblA_Max1_Step1
Dim dblA_Min1_Step1
Dim dblA_Max1_Qcm
Dim dblA_Min1_Qcm

dblA_Max1_Step1 = dblA_Max1 * 1000000
dblA_Min1_Step1 = dblA_Min1 * 1000000

dblA_Max1_Qcm = (Int (dblA_Max1_Step1)) / 100
dblA_Min1_Qcm = (Int (dblA_Min1_Step1)) / 100

MsgBox "max. Querschnitt: " & dblA_Max1_Qcm & "cm²" & vbTab & "(" & strNamemax1 & ")" & vbCrLf _
& "min. Querschnitt: " & dblA_Min1_Qcm & "cm²" & vbTab & "(" & strNamemin1 & ")", 0, "Querschnittsanalyse erfolgreich durchgeführt"

End Sub

Edit:
@Joe
ich habe deinen Beitrag erst jetzt gelesen, danke für die Info, ich schau mir das heute auf jeden Fall noch an 

Lg Jan

[Diese Nachricht wurde von Tube3 am 28. Nov. 2014 editiert.]

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