Autor
|
Thema: Punkt einfärben & Symbol ändern (4268 mal gelesen)
|
mycon Mitglied
Beiträge: 58 Registriert: 14.02.2011 Catia V5R19
|
erstellt am: 13. Apr. 2011 12:35 <-- editieren / zitieren --> Unities abgeben:
Hi, ich habe mir in einer Zeichnungsansicht mit Dim Fac2D As Factory2D Set Fac2D = drawingView1.Factory2D Dim Point As Point2D Set Point = Fac2D.CreatePoint(0, 0) Point.Construction = False einen Mittelpunkt erzeugt. Den würde ich gerne einfärben und das Symbol verändern, finde aber nichts das das bewerkstelligen kann. Kann mir da jemand helfen? Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
JuPaV Mitglied Software-Entwickler
Beiträge: 39 Registriert: 11.11.2010 CATIA V5R20SP364 CATScript, CATVba, VB6, .NET, C++, NXOpen
|
erstellt am: 13. Apr. 2011 12:59 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Hallo mycon! Zitat:
Dim Fac2D As Factory2D Set Fac2D = drawingView1.Factory2D Dim Point As Point2D Set Point = Fac2D.CreatePoint(0, 0) Point.Construction = False
und weiter: Code:
Set osel = CATIA.ActiveDocument.Selection osel.Clear osel.Add Point2 osel.VisProperties.SetRealColor 255, 0, 1, 1 'FARBE osel.VisProperties.SetSymbolType 4 'SYMBOL TYPE
------------------ Mit freundlichen Grüßen, JuPaV Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
mycon Mitglied
Beiträge: 58 Registriert: 14.02.2011 Catia V5R19
|
erstellt am: 13. Apr. 2011 17:37 <-- editieren / zitieren --> Unities abgeben:
|
tobi26 Mitglied
Beiträge: 4 Registriert: 01.08.2017 CATIA V5-6 R2016
|
erstellt am: 01. Aug. 2017 10:08 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Sorry fürs "Leichenfläddern", aber ich hab ein ähnliches Problem und bei mir funktioniert die das ändern der Farbe und des Typs nicht. Anbei der Codeausschnitt: Code:
Do ' Spalte 1 = Name // Spalte 2,3,4,5,6,7,8 = Werte Element = (WS.Cells(nRow, 1).Text) Laenge = CDbl(WS.Cells(nRow, 2).Value) XCoord = CDbl(WS.Cells(nRow, 3).Value) YCoord = CDbl(WS.Cells(nRow, 4).Value) ZCoord = CDbl(WS.Cells(nRow, 5).Value) XDir = CDbl(WS.Cells(nRow, 6).Value) YDir = CDbl(WS.Cells(nRow, 7).Value) ZDir = CDbl(WS.Cells(nRow, 8).Value) ' Punkt mit den Koordinaten erstellen Set Point = HybShapeFac.AddNewPointCoord(XCoord, YCoord, ZCoord) ' Punkt in Hauptkörper einfügen Messpunkte.AppendHybridShape Point Point.Name = Element + "_Startpunkt" ' wenn Länge ungleich 0 If Laenge <> 0 Then ' Punkt 2 berechnen Set Point2 = HybShapeFac.AddNewPointCoord(XCoord+XDir*Laenge, YCoord+YDir*Laenge, ZCoord+ZDir*Laenge) 'Punkt 2 in Hauptkörper einfügen Messpunkte.AppendHybridShape Point2 Point2.Name = Element + "_Endpunkt" ' Verbindungslinie erstellen Set Line = HybShapeFac.AddNewLinePtPt(Point, Point2) ' Linie in Hauptkörper einfügen Messpunkte.AppendHybridShape Line Line.Name = Element + "_Vektor" ' Vektorlänge gleich Null -> Punkt einfärben Else Set osel = CATIA.ActiveDocument.Selection osel.clear osel.Add Point osel.VisProperties.SetRealColor 255, 0, 0, 1 'Farbe definieren osel.VisProperties.SetSymbolType 4 'Darstellung Punkt ändern End If ' Zeile hochzählen nRow = nRow + 1 ' Schleife verlassen, wenn Zelle leer ist Loop While (WS.Cells(nRow, 2).Text <> "")
Ich les hier aus einer Excel-Tabelle Koordinaten ein, erzeuge einen Startpunkt, einen Endpunkt und eine Verbindungslinie. Soweit funktioniert alles. Ich fange über eine Schleife den zweiten Punkt ab wenn die Länge zwischen den Punkten gleich 0 ist. Diesen Punkt möchte ich jeweils in der Farbe und in der Darstellung ändern. Leider klappts mit dem Codeschnippselt so nicht... Danke schonmal für die Hilfe Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 01. Aug. 2017 10:45 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Servus Tobi Willkommen im Forum. Bitte Systeminfo ausfüllen. Im Code kann ich keinen Fehler erkennen. Wird denn die Else-Verzweigung aufgerufen? Wird der Punkt selektiert? (zB Makro dort mal unterbrechen) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
tobi26 Mitglied
Beiträge: 4 Registriert: 01.08.2017 CATIA V5-6 R2016
|
erstellt am: 01. Aug. 2017 11:33 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Die Infos hab ich mal ergänzt. Danke schonmal fürs drauf schauen. Ich hab mir das etwas zusammen geschustert. Und meine VBA-Kenntnisse sind von vor 10 Jahren und seitdem hab ich nie wieder etwas in VBA programmiert, geschweige denn in CATIA überhaupt. Wie kann ich das Makro denn Schritt für Schritt durchlaufen lassen? Grüße Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 01. Aug. 2017 11:37 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
|
tobi26 Mitglied
Beiträge: 4 Registriert: 01.08.2017 CATIA V5-6 R2016
|
erstellt am: 01. Aug. 2017 12:57 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Hab ich jetzt hin bekommen, allerdings bleibt der Compiler schon mit ner Fehlermedung stehen (siehe Anhang) Er stört sich anscheinend an der Variablendeklaration. Problem ist da aktuell das Dim WB As Workbook Ich hab hier mal den Kompletten Code, glaub sonst macht das keinen Sinn... Code:
Sub CATMain() m1 End Sub '-------------------------------------------------------------------------------- Sub m1() ' V101: Abfrage auf geöffnetes Dokument von mre eingefügt '-------------------------------------------------------------- On Error Resume Next Set doc = CATIA.ActiveDocument If Err.Number <> 0 Then MsgBox "Bitte zuerst ein CATPart öffnen!", vbCritical, "Abbruch" Exit Sub End If '-------------------------------------------------------------- 'Filter: Part geoeffnet. Set adoc = CATIA.ActiveDocument If TypeName(adoc) <> "PartDocument" Then MsgBox "Bitte zuerst ein CATPart öffnen!", vbCritical, "Abbruch" Exit Sub End If '-------------------------------------------------------------- Dim Excel As Application Dim WB As Workbook Dim WS As Worksheet Dim Element As Text Dim XCoord As Double Dim YCoord As Double Dim ZCoord As Double Dim XDir As Double Dim YDir As Double Dim ZDir As Double Dim Laenge As Double Dim nRow As Integer Dim Part1 As Part Dim HybShapeFac As Factory Dim Point As HybridShapePointCoord Dim Point2 As HybridShapePointCoord Dim Factor As Double Dim Line As HybridShapeLinePtPt Dim HKoerper As HybridBodies Dim Messpunkte As HybridBody Dim oEingabe Dim cDateiPfad CATIA.DisplayFileAlerts = False Dim Message, Style, Title, Response, MyString Message = ("Dieses Makro importiert Punkte aus einer Exceltabelle. Folgendes ist zu beachten:" &_ ""&(chr(13))&_ (chr(13)) &_ " - Werte erst ab Zeile 2"&_ (chr(13)) &_ " - Spalten A-H = Name - X-Koordinate - Y-Koordinate - Z-Koordinate - X-Richtung - Y-Richtung - Z-Richtung - Laenge (Werte als normale Zahl mit . getrennt)"&_ (chr(13)) &_ ""&(chr(13))&_ " Willst du fortfahren ?") Style = vbYesNo + vbDefaultButton2 'Define buttons. Title = "Punkte importieren " Response = MsgBox(Message, Style, Title) If Response = vbYes Then ' User chose Yes. MyString = "Yes" ' Excel starten
Set Excel = CreateObject("Excel.Application") ' Excel starten Excel.Visible = True NameZiel = Excel.Application.GetOpenFilename("XLS-Dateien (*.xls),*.xls,", , "XLS-Dateien für den Punkteimport auswählen!") If NameZiel = False Then MsgBox "eine Datei auswählen!" Exit Sub End If Set WB = Excel.Workbooks.Open(NameZiel) ' arbeitsmappe öffnen ' tabelle holen Set WS = WB.Worksheets.Item(1) ' aktives part holen Set Part1 = CATIA.ActiveDocument.Part ' factory zu erstellen der Punkte Set HybShapeFac = Part1.HybridShapeFactory ' hauptkörper holen zum einfügen der Punkte Set HKoerper = CATIA.ActiveDocument.Part.HybridBodies Set Messpunkte = HKoerper.Add() 'has: GeometricalSet umbenennen GS_Name = WB.Name Messpunkte.Name = GS_Name 'mystring = oItem.Value.Name 'Position von rechts aus des \ ermitteln SuchZeichen = "." pt_pos = InstrRev(GS_Name, SuchZeichen, -1, 1) pt_pos = pt_pos - 1 If pt_pos <> 0 Then 'String von links bis "." behalten new_str = Left(GS_Name, pt_pos) End If 'Reduzierten Stirng wieder zurückgeben Messpunkte.Name = new_str ' Koordianten beginnen in der 5 Zeile der Tabelle nRow = 5 ' Zeilen solange einlesen bis nichts mehr drin steht Do ' Spalte 1 = Name // Spalte 2,3,4,5,6,7,8 = Werte Element = (WS.Cells(nRow, 1).Text) Laenge = CDbl(WS.Cells(nRow, 2).Value) XCoord = CDbl(WS.Cells(nRow, 3).Value) YCoord = CDbl(WS.Cells(nRow, 4).Value) ZCoord = CDbl(WS.Cells(nRow, 5).Value) XDir = CDbl(WS.Cells(nRow, 6).Value) YDir = CDbl(WS.Cells(nRow, 7).Value) ZDir = CDbl(WS.Cells(nRow, 8).Value) ' Punkt mit den Koordinaten erstellen Set Point = HybShapeFac.AddNewPointCoord(XCoord, YCoord, ZCoord) ' Punkt in Hauptkörper einfügen Messpunkte.AppendHybridShape Point Point.Name = Element + "_Startpunkt" ' Punkt2 berechnen ' Factor = sqrt(((-sqrt((2*XCoord*XDir+2*YCoord*YDir+2*ZCoord*ZDir)^2 - 4*(XDir^2 + YDir^2 + ZDir^2) * (XCoord^2 + YCoord^2 + ZCoord^2 - Laenge^2)) - 2*XCoord*XDir - 2*YCoord*YDir - 2*ZCoord*ZDir)/(2* (XDir^2 + YDir^2 + ZDir^2)))^2) ' Factor = 2 ' Set Point2 = HybShapeFac.AddNewPointCoord(XCoord+XDir*Factor, YCoord+YDir*Factor, ZCoord+ZDir*Factor) ' wenn Länge ungleich 0 If Laenge <> 0 Then ' Punkt 2 berechnen Set Point2 = HybShapeFac.AddNewPointCoord(XCoord + XDir * Laenge, YCoord + YDir * Laenge, ZCoord + ZDir * Laenge) 'Punkt 2 in Hauptkörper einfügen Messpunkte.AppendHybridShape Point2 Point2.Name = Element + "_Endpunkt" ' Verbindungslinie erstellen Set Line = HybShapeFac.AddNewLinePtPt(Point, Point2) ' Linie in Hauptkörper einfügen Messpunkte.AppendHybridShape Line Line.Name = Element + "_Vektor" ' Vektorlänge gleich Null -> Punkt einfärben Else Set osel = CATIA.ActiveDocument.Selection osel.clear osel.Add Point osel.VisProperties.SetRealColor 255, 0, 0, 1 'Farbe definieren osel.VisProperties.SetSymbolType 4 'Darstellung Punkt ändern End If ' Zeile hochzählen nRow = nRow + 1 ' Schleife verlassen, wenn Zelle leer ist Loop While (WS.Cells(nRow, 2).Text <> "") ' Part aktualisieren Part1.Update ' Excel schliessen Excel.Quit MsgBox "Fertig !" & vbCrLf & s ' Else ' User chose No. MyString = "No" End If End Sub
[Diese Nachricht wurde von tobi26 am 01. Aug. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 01. Aug. 2017 13:09 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Servus Hast du die Excel-Biblothek in den Referenzen aktiviert? Bitte schmeiß mal das on Error resume next raus (bzw verwende es nur sparsam (zb danach die Fehlerbehandlung wieder aktivieren) und wenn du weißt was es macht). Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
tobi26 Mitglied
Beiträge: 4 Registriert: 01.08.2017 CATIA V5-6 R2016
|
erstellt am: 01. Aug. 2017 14:20 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Ich hab die Excel-Bibliothek eingebunden, und ich musste die Excel-Variable in oExcel umbenennen, dann ging das zumindest wieder. Ist schon interessant, dass sich das direkt geöffnete .Catscript anders verhält, wie wenn ich den Code über VBA ausführe... Das nächste Problem, in VBA ändert er den Namen der Punkte und Linien nicht mehr. Anscheind kann nicht auf die Werte zugegriffen werden. Aber der Punkt wird zumindest im Baum selektiert. Aber dann beginnt wieder das Problem, dass er nichts ändert. Wie bei den Namen kann er hier nciht auf das Element zugreifen. [Diese Nachricht wurde von tobi26 am 01. Aug. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 01. Aug. 2017 15:53 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
Servus Ist die Variable Element gefüllt? Deklariere diese mal als String. Lass dir mal testweise vor dem Umbenennen den kompletten Namen ausgeben. Kannst du den Namen der Punkte und Linie auslesen? Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Moderator Freiberuflicher Konstrukteur
Beiträge: 1057 Registriert: 25.11.2006 Win7 Pro 64 + Ubuntu + Irix6.5.20 Dell Precision M6600 i7-2960XM 2.7GHz 16GB NVidia Quadro M5010 Catia V5R19 VB6Pro.SP6/VBA 6.5.1053
|
erstellt am: 01. Aug. 2017 20:01 <-- editieren / zitieren --> Unities abgeben: Nur für mycon
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|