Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Kurze Linien in View auf einen bestimmten Layer schieben

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:  Kurze Linien in View auf einen bestimmten Layer schieben (1232 mal gelesen)
reimund
Mitglied



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

Beiträge: 231
Registriert: 29.10.2004

CATIA V5 / R26
NX 12

erstellt am: 11. Aug. 2010 11:34    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 Zusammen,
unter V5 R18 habe ich in einem CATScript folgendes programmiert:

In einer Drawing selektiere ich eine View und innerhalb der View werden alle Objekte auf Layer 0 gesetzt. Anschließend werden in der View alle Linien gesucht, selektiert und die Länge der Linien ausgewertet.
Nach der Längenauswertung erfolgt eine Abfrage bzgl. der Linienlänge und im Moment nur eine Msgbox mit dem Hinweis, dass die Linie auf einen anderen Layer geschoben werden muss.
Das Linienobjekt mit dem ich die Längenauswertung gemacht wird heißt: oSel.Item2(iZaehler). Doch dieses kann für die Visproperties nicht angesprochen werden, es kommt die Fehlermeldung: Das Objekt unterstützt die Eigenschaft oder Methode nicht.

Hier der Codeausschnitt:

Dim iZaehler As Integer
iZaehler = 0
For iZaehler = 1 To iCount_SelectedElements
dim select_line as selection
set select_line = oSel.Item2(iZaehler)
'oSel.Item2(iZaehler).Value.StartPoint.GetCoordinates intStartPointCoordArr
'oSel.Item2(iZaehler).Value.EndPoint.GetCoordinates intEndPointCoordArr
select_line.Value.StartPoint.GetCoordinates intStartPointCoordArr
select_line.Value.EndPoint.GetCoordinates intEndPointCoordArr

'***Punktkoordinaten auslesen
dx1 = intStartPointCoordArr(0)
dy1 = intStartPointCoordArr(1)
dx2 = intEndPointCoordArr(0)
dy2 = intEndPointCoordArr(1)
'Länege über Pythagoras berechnen

dim dine_length
dline_length = Round(Sqr(((dx2 - dx1) ^ 2) + ((dy2 - dy1) ^ 2)), 3)
MsgBox ("Linie " & iZaehler & " // Name: " & select_line.value.name &" // Länge  in mm : " & dline_length)
'Vergleich der errechneten Lenge zur Maximallaenge
'*************Ende Linienlaenge berechnen

'*************Start Laenge der Line zur Mindestlaenge vergleichen
Dim dmin_length As Double
dmin_length = 50
If dline_length < dmin_length Then
MsgBox "Linie " & iZaehler &  " // Name: " & select_line.value.name &" : Länge  = " & dline_length & " mm" & "  ist < als 50 mm: " & "Linie muss auf Layer 2 geschoben werden!"
  Dim visProperties2 'As CatVisLayerType
  Set visProperties2 =oSel.Item2(iZaehler).VisProperties ' !!!Hier ist der Fehler !!!!
  visProperties1.SetLayer catVisLayerBasic, 2
Else
MsgBox "Linie " & iZaehler & "  // Name: " & select_line.value.name &": Länge  = " &    dline_length & " mm" & " ist > als 50 mm: " & "Linie bleibt erhalten!"
End If
Next
'*************Ende Laenge der Line zur Mindestlaenge vergleichen


Wie kann ich dieses eine selektierte Objekt oSel.Item2(iZaehler) ansprechen, damit es auf einen Layer (Layer 2) geschoben werden kann?

Gruß
Reimund

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

DanielFr.
Moderator
Manager


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

Beiträge: 2506
Registriert: 10.08.2005

HP Compaq 8710w, Intel Core Duo T7700, 2,40 Ghz, 3GB RAM, Windows XP Professionel @32bit, Quadro FX 1600M, CATIA V5 R19 SP3

erstellt am: 11. Aug. 2010 12: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 Nur für reimund 10 Unities + Antwort hilfreich

Hallo Reimund  ,

das Probelm bei deinem Code ist das sich die VisProperties Eigenschaft nur auf die Selection anwenden lässt aber nicht auf ein SelecedElement. Durch deine Zuweisung erhält das Objekt "select_line" aber den Datentyp SelectedElement. Dies verursacht den Fehler. Die Lösung ist recht einfach. Du erstellt dir ein weiteres Array (oder Collection in VBA). In diese Array verschiebst du noch vor deiner Schleife alle selektierten Linien. Jetzt läufst du mit deiner Schleife nicht innerhalb der Selektion die Linienobjekte ab sondern innerhalb des Datenfeldes. Wenn eine Linien dein Prüfkriterium verletzt, dann verschiebst du sie in den "freigewordene" Selektion. Auf diese Selektion wendest du dann die VisProperties Eigenschaft an und dann kannst die Linie in der If-Abfrage auf den Layer verschieben. Vor dem beenden der If-Abfrage musst du die Selektion wieder leeren denn da kann ja eine neue Linie reinkommen. Das ganze kann man natürlich auch so aufbauen das man zu erst alle Linien die kürzer als 50m sind in die Selektion verschriebt und die ganze Selektion nach der For-Schleife auf den Layer 2 hebt 

Anbei mal mein Beispielcode:

Code:
Sub CATMain()

    '***DAS IST MEIN CODE UM DEINEN ZUM LAUFEN ZU BRINGEN (NUR FÜR TEST ERFORDERLICH)
    Dim intDrwDocObj As DrawingDocument
    Dim oSel As Selection
    Dim iCount_SelectedElements As Long
   
    Set intDrwDocObj = CATIA.ActiveDocument
    Set oSel = intDrwDocObj.Selection
    oSel.Clear
   
    oSel.Search "CATDrwSearch.2DLine,all"
   
    iCount_SelectedElements = CLng(oSel.Count)
   
    If iCount_SelectedElements = 0 Then
        MsgBox "Keine Linien gefunden", vbCritical, "ABBRUCH"
        Exit Sub
    End If
   
    'ENDE**********

   
    '***ALLE DEKLARTAIONEN VOR DIE SCHLEIFE!!!
    Dim iZaehler As Integer
    Dim intAllLineObj()
    Dim i As Long
    Dim select_line As Object 'Line2D NUR IN VBA!!!
    Dim dine_length
    Dim dmin_length As Double
    Dim visProperties2 'As CatVisLayerType
    Dim intStartPointCoordArr(2)
    Dim intEndPointCoordArr(2)
   
   
   
    '***DIE VISPROPERTIES EIGENSCHAFT EXISTIERT NUR FÜR DIE SELECTION NICHT FÜR SELECTEDELEMENTS!!!
    '***D.H. DU BRAUCHST EIN ZWEITES ARRAY IN DEM DU ERST MAL ALLE SELEKTIERTEN LINIEN ABLEGEN KANNST
    '***DIE URSPRÜNGLICHE SELEKTION WIRD FÜR DIE VISPROPERTIES EIGENSCHAFT BENÖTIGT
    ReDim intAllLineObj(iCount_SelectedElements - 1)
    For i = 0 To iCount_SelectedElements - 1
        Set intAllLineObj(i) = oSel.Item(i + 1).Value
    Next
   
    oSel.Clear
   
    iZaehler = 0
   
    For iZaehler = 0 To iCount_SelectedElements - 1
        'HIER DAS LINIENOBJEKT HOLEN
        Set select_line = intAllLineObj(iZaehler)
       
        'HIER KANNST DU DANN GLEICH MIT DIESEM OBJEKT ARBEITEN (KEIN .VALUE MEHR)
        select_line.StartPoint.GetCoordinates intStartPointCoordArr
        select_line.EndPoint.GetCoordinates intEndPointCoordArr
       
        '***Punktkoordinaten auslesen
        dx1 = intStartPointCoordArr(0)
        dy1 = intStartPointCoordArr(1)
        dx2 = intEndPointCoordArr(0)
        dy2 = intEndPointCoordArr(1)
        'Länege über Pythagoras berechnen
       
   
        dline_length = Round(Sqr(((dx2 - dx1) ^ 2) + ((dy2 - dy1) ^ 2)), 3)
        MsgBox ("Linie " & iZaehler + 1 & " // Name: " & select_line.Name & " // Länge  in mm : " & dline_length)
        'Vergleich der errechneten Lenge zur Maximallaenge
        '*************Ende Linienlaenge berechnen
       
        '*************Start Laenge der Line zur Mindestlaenge vergleichen
   
        dmin_length = 50
        If dline_length < dmin_length Then
            MsgBox "Linie " & iZaehler + 1 & " // Name: " & select_line.Name & " : Länge  = " & dline_length & " mm" & "  ist < als 50 mm: " & "Linie muss auf Layer 2 geschoben werden!"
           
            'LINIE IN SELEKTION SCHICKEN
            oSel.Add select_line
           
            'VISPROPERTIES EIGENSCHAFT DIESER SELEKTION HOLEN
            Set visProperties2 = oSel.VisProperties
           
            'LINIE AUF LAYER LEGEN
            visProperties2.SetLayer catVisLayerBasic, 2
           
            'SELEKTION LEEREN
            oSel.Clear
        Else
            MsgBox "Linie " & iZaehler + 1 & "  // Name: " & select_line.Name & ": Länge  = " & dline_length & " mm" & " ist > als 50 mm: " & "Linie bleibt erhalten!"
        End If
    Next
    '*************Ende Laenge der Line zur Mindestlaenge vergleichen
End Sub


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

Systeminformation | Inoffizielle CATIA Hilfeseite | CATIA FAQ | Suche | TraceParts (Normteile...) | 3D Content Central (noch mehr Normteile...)

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

reimund
Mitglied



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

Beiträge: 231
Registriert: 29.10.2004

erstellt am: 11. Aug. 2010 14:45    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 Daniel,
vielen Dank für deine Hilfe.
Ich habe das Verschieben der Linien auf den anderen Layer nach die Schleife gesetzt und es funktioniert auch.

Gruß
Reimund

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)2023 CAD.de | Impressum | Datenschutz