---

Hallo,

wie kann ich alle Referenzkreise in einer Zeichnung so umstellen, dass die Umrahmung des Textes ohne Kreis ist? Von Hand: rechte Maustaste auf Referenzkreis => Eigenschaften => Register Text => Umrahmung

Die Auswahl der Referenzkreise funktioniert so

Language="VBSCRIPT"

Sub CATMain()

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument

'Referenzkreis ändern
Dim VisProperties1 As VisPropertySet
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection

selection1.Search "Drafting.Balloon;all"

'Code ?

selection1.Clear

End Sub

Vielen Dank

Georg

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

---

Hallo Georg,

das Makro selektiert alle Ballons auf der Zeichnung und setzen den Rahmen falls er NICHT catNone (kein Rahmen) ist auf catNone.
Language="VBSCRIPT"

Code:

---

Sub CATMain()

Dim oDoc As Document
Dim oSel As Selection
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

oSel.Search "Drafting.Balloon;all"

i = 1
For i = 1 To oSel.Count
Set oBallon = oSel.Item(i).Value
If oBallon.FrameType <> catNone Then
    oBallon.FrameType = catNone
End If
Next

oSel.Clear

'Kannst auch auskommentieren
Box = MsgBox("Die TextFrames von " & i & " Referenzkreisen wurden geändert!", vbInformation, "Makro erfolgreich beendet")
End Sub

---

------------------
MFG Daniel

Die KATJA ist halt doch nur ne zickige Französin

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

---

Super vielen Dank. Wie kann ich jetzt noch die Schriftgröße auf 5 und Symbol Shape auf Filled Circle umstellen? Wo finde ich die entsprechenden Parameter, damit ich auf diese zugreifen kann?

Vielen Dank

Georg

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

---

Hallo,

Code:

---

For i = 1 To oSel.Count
Set oBallon = oSel.Item(i).Value

---

In der ersten Zeile fängt die Schleife an und zwar von 1 bis zur Anahl aller in der Selektion vorhandenen Teile. In der Selektion sind natürlich alle auf der Zeichnung verfügbaren Ballons.

In der zweiten Zeile wird jetzt jeder Ballon einzaln angesprochen. Zuerst kannst du alle zugängigen Eigenschaften des ersten, dann des zweiten usw. Ballons ändern.

Du müsstest also das mit der Schriftart und der Pfeil nach der zweiten Zeile einfügen

Hier mal der neue Code

Code:

---

Sub CATMain()

Dim oDoc As Document
Dim oSel As Selection
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

oSel.Search "Drafting.Balloon;all"

i = 1
For i = 1 To oSel.Count
Set OBallon = oSel.Item(i).Value
    If OBallon.FrameType <> catNone Then
        OBallon.FrameType = catNone
    End If
    OBallon.Leaders.Item(1).HeadSymbol = catFilledCircle
    OBallon.TextProperties.FONTSIZE = 5
Next

oSel.Clear

'Kannst auch auskommentieren
Box = MsgBox("Die TextFrames von " & i & " Referenzkreisen wurden geändert!", vbInformation, "Makro erfolgreich beendet")
End Sub

---

------------------
MFG Daniel

Die KATJA ist halt doch nur ne zickige Französin

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

---

Hallo Daniel,

vielen Dank. Das Script läuft bis

OBallon.TextProperties.FONTSIZE = 5

An was liegt das? Vielen Dank nochmals. Du hast mir sehr geholfen.

Viele Grüße

Georg

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

---

Hallo GeorgK,

ist jetzt nicht getestet, doch probier doch mal folgende Variante:

Code:

---

OBallon.TextProperties.SetFontSize 0, 0, 5

---

wobei die erste Null der erste Charakter für die Textgröße "5" (letzter Parameter) ist und die zweite Null die Anzahl der Zeichen für Textgröße "5" ab dem Start-Charakter.

mfg,
Lusilnie

------------------

Alle Aussagen zu DassaultSystemes-Produkten sind sehr optimistisch, selbst diese!!!

frei nach größeren Geistern

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

---

Hallo,

ich geb Lusilnie natürlich rechts. So sollte es funktionieren. In MS VB Editor ist diese Angabe jedoch nicht erforderlich deswegen steht sie nicht im Quelltext

------------------
MFG Daniel

Die KATJA ist halt doch nur ne zickige Französin

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

---

Hallo zusammen,

leider hakt es an der gleichen Stelle wieder. Wer weiß an was das liegt?

Vielen Dank

Georg

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

---

Hallo Georg,

du hast dich nicht verständlich ausgedrückt. Ich denke mal die meisten sind davon ausgegangen das das Makro an dieser Stelle hängt, oder abbricht.
Dem ist aber nicht so. Das Makro macht lediglich die Änderung nicht und das stimmt auch. Den Textproperties werden erst nach einem Update übernommen.

Hier der Code. Jetzt funktioniert er 

Code:

---

Sub CATMain()

'Dim oDoc As Document
'Dim oSel As Selection
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

oSel.Search "Drafting.Balloon;all"

i = 1
For i = 1 To oSel.Count
Set OBallon = oSel.Item(i).Value
    If OBallon.FrameType <> catNone Then
        OBallon.FrameType = catNone
    End If
    OBallon.Leaders.Item(1).HeadSymbol = catFilledCircle
    OBallon.TextProperties.FONTSIZE = 5
    OBallon.TextProperties.Update
Next

oSel.Clear

'Kannst auch auskommentieren
Box = MsgBox("Die TextFrames von " & i & " Referenzkreisen wurden geändert!", vbInformation, "Makro erfolgreich beendet")
End Sub

---

Makro hab ich getestet und es läuft als CATvba und CATScript einwandfrei.

------------------
MFG Daniel

Die KATJA ist halt doch nur ne zickige Französin

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

---

Hallo Daniel,

bei mir läuft das Makro unter V5R16 SP5 HF77 nicht. Habe mir jetzt so geholfen:

Sub CATMain()

Dim oDoc As Document
Dim oSel As Selection
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection
Dim FontSize As Double

oSel.Search "Drafting.Balloon;all"

i = 1
For i = 1 To oSel.Count
Set OBallon = oSel.Item(i).Value
    If OBallon.FrameType <> catNone Then
        OBallon.FrameType = catNone
    End If
    OBallon.Leaders.Item(1).HeadSymbol = catFilledCircle
   
Next

oSel.Clear

Dim selection1 As Selection
Set Selection = oDoc.Selection

Selection.Search "Drafting.Balloon;all"

SendKeys "%{Enter}"

End Sub

Vielen Dank nochmals

Georg

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