Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de
  CATIA V5 Programmierung
  Drawing: Erzeugte Netzlinien zu Set hinzufügen für einfaches Löschen

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
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für CATIA & Co.
  
Erfolgreich unterwegs mit der KISTERS 3DViewStation, ein Whitepaper
Autor Thema:  Drawing: Erzeugte Netzlinien zu Set hinzufügen für einfaches Löschen (2390 mal gelesen)
wootpecker
Mitglied


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

Beiträge: 4
Registriert: 26.02.2014

CATIA V5R19, CATIA V5R20, CATIAV5R21
Win 7, 64bit

erstellt am: 01. Aug. 2014 13:42    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 Leute,

Ich habe ein funktionierendes makro für die Erzeugung von Netzlinien im Drawing.

Habe ich nun Netzlinien erzeugt und möchte sie editieren oder löschen, müsste ich über Rückgängig oder löschen die Netzlinien einzeln löschen.

Wie kann man es am günstigsten machen, dass das makro die erstellten Netzlinien in eine Art "Gruppe" zusammenfügt, sodass mit auswählen einer linie alle ausgewählt werden, inklusive Textfelder?


Eventuell ein anderes Script?


tldr; Vorhanden: Script, welches im CATIA drawing in einem Loop Linien erzeugt und ausgibt.
      gesucht: Befehlzeile, welche die erzeugten Linien in eine Gruppe fügt, für einfaches Löschen/Bearbeiten zu einem späteren Zeitpunkt.

Gruß und vielen Dank schon im Voraus

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

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3437
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 01. Aug. 2014 13:52    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 wootpecker 10 Unities + Antwort hilfreich

Hallo wootpecker,

könntest auch ein Detail erstellen.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

wootpecker
Mitglied


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

Beiträge: 4
Registriert: 26.02.2014

CATIA V5R19, CATIA V5R20, CATIAV5R21
Win 7, 64bit

erstellt am: 01. Aug. 2014 13:58    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

Kannst du mir das etwas genauer erläutern?

[Diese Nachricht wurde von wootpecker am 01. Aug. 2014 editiert.]

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

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3437
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 01. Aug. 2014 14:18    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 wootpecker 10 Unities + Antwort hilfreich

Programmiertechnisch kann ich dir das nicht wirklich erklären.

Konstruktiv soviel, das man im Drawing mehrfachverwendete Elemente wie einen Titelblock der aus mehreren Elementen besteht in einem Detail zusammenfassen kann.

Ändert man nun das Detail werden sie an jeder Stelle wo sie platziert sind aktualisiert.

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

wootpecker
Mitglied


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

Beiträge: 4
Registriert: 26.02.2014

CATIA V5R19, CATIA V5R20, CATIAV5R21
Win 7, 64bit

erstellt am: 01. Aug. 2014 14:35    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

Hmm. Danke Uwe für deine Idee. Ich lass Sie mir mal durch den Kopf gehen.


Also das Ding ist, das die Netzlinien in einer Loop erstellt werden:

Do While (liney < Y2 - Y1)
    Set Linev = o2DFactory.CreateLine(X1 - 10, Y1 + liney, X2, Y1 + liney)
    selection1.Add (Linev)
    visProperties1.SetRealLineType 1, 1
    visProperties1.SetRealWidth 1, 1
    Set Text = drawingview1.Texts.Add(texthor & (Y1 + liney), X1 - 40, Y1 + liney)
    Text.SetFontSize 0, 0, 5
    liney = liney + abstand
    k = k + 1
Loop

Mein Gedanke war, dass man jede Linie, die im Loop erstellt wird, in eine Art "Set" hinzufügt, sodass am Ende ein Set mit allen Linien und Linienbeschriftungen vorhanden ist.

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

moppesle
Ehrenmitglied V.I.P. h.c.
Konstrukteur


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

Beiträge: 3437
Registriert: 28.05.2009

CATIA V5 R19 SP9
WIN 7 64bit

erstellt am: 01. Aug. 2014 14:44    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 wootpecker 10 Unities + Antwort hilfreich

Hallo,

Zitat:
Mein Gedanke war, dass man jede Linie, die im Loop erstellt wird, in eine Art "Set" hinzufügt, sodass am Ende ein Set mit allen Linien und Linienbeschriftungen vorhanden ist.

Also wenn man das "händisch" macht, dann ist das von dir benannte "Set" das Detail.

Könnte mir vorstellen, das man ein Detailsheet mit einer View über VB erstellen kann.
Weiß es aber leider nicht genau, da ich keine Programmierkenntnisse habe.


Schau mal in die Doku unter. "Referenz einer 2D-Komponente erneut verwenden"

------------------
Gruß Uwe

Auch Catia ist nur ein Mensch!    

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

joehz
Mitglied
Freiberuflicher Konstrukteur


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

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: 02. Aug. 2014 17:44    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 wootpecker 10 Unities + Antwort hilfreich

Hallo Wootpecker,

die von Deinem Makro erzeugten Linien und Punkte liegen unter drViewName.GeometricElements, und zwar ab item 2; Item 1 ist das Achsensystem. Bei den Texten ist's drViewName.Texts.
Wenn Du den Linien und Texten jetzt einen Tag mitgibst(sie umbenennst), zB. "NET_" & ElementName, dann kannst Du Sie alle in einer Selection einfangen - und zwar quer über alle views.
Die zu den Linien gehörenden Endpunkte fallen allerdings durch das Raster.
Wenn Du nur die Netzlinien/Texte einer einzelnen View löschen willst, musst halt noch den Parent.Parent abfragen. Oder gezielt bei der einen View die GeometricElements und Texts durchlaufen.

Hope it helps.

Tschau,
Joe

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

joehz
Mitglied
Freiberuflicher Konstrukteur


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

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: 02. Aug. 2014 17:48    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 wootpecker 10 Unities + Antwort hilfreich

Kleiner Nachtrag zum vorherigen:

Die Endpunkte der Linien werden mit den Linien gelöscht.

Tschau,
Joe

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

wootpecker
Mitglied


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

Beiträge: 4
Registriert: 26.02.2014

CATIA V5R19, CATIA V5R20, CATIAV5R21
Win 7, 64bit

erstellt am: 05. Aug. 2014 12:17    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 Joe,

vielen Dank für deine Hilfe.

Mein Problem ist, dass ich nicht weiß wie ich es genau umsetzen kann.
Könntest du mir vielleicht Hilfestellung leisten?

Unten folgend der Ausschnitt vom Makro für das Erstellen der Netzlinien.

Gruß
______________________________________________________

Set drawingSheets1 = drawingDocument1.Sheets
Set drawingSheet1 = drawingSheets1.ActiveSheet
Set drawingViews1 = drawingSheet1.Views
Set drawingView1 = drawingViews1.ActiveView

Dim Xn
Dim Yn
Dim Zn
Dim texthor
Dim textvert

drawingView1.GenerativeBehavior.GetProjectionPlaneNormal Xn, Yn, Zn

If Int(Xn) = 1 Or Int(Xn) = -1 Then
    texthor = "Z"
    textvert = "Y"
ElseIf Int(Yn) = 1 Or Int(Yn) = -1 Then
    texthor = "Z"
    textvert = "X"
ElseIf Int(Zn) = 1 Or Int(Zn) = -1 Then
    texthor = "Y"
    textvert = "X"
End If


Dim X1, Y1, X2, Y2
X1 = Int(DrawingWindowLocation1(0) / abstand) * abstand
If DrawingWindowLocation1(0) - X1 > 0 Then
    X1 = X1 + abstand
End If

If DrawingWindowLocation1(0) - X1 > 0 Then
    X1 = X1 + abstand
End If

Y1 = Int(DrawingWindowLocation1(1) / abstand) * abstand
If DrawingWindowLocation1(1) - Y1 > 0 Then
    Y1 = Y1 + abstand
End If

X2 = Int(DrawingWindowLocation2(0) / abstand) * abstand
If DrawingWindowLocation2(0) - X2 < 0 Then
    X2 = X2 - abstand
End If
Y2 = Int(DrawingWindowLocation2(1) / abstand) * abstand
If DrawingWindowLocation2(1) - Y2 < 0 Then
    Y2 = Y2 - abstand
End If

Set o2DFactory = drawingView1.Factory2D
Set Line1v = o2DFactory.CreateLine(X1, Y1 - 10, X1, Y2)

selection1.Clear
selection1.Add (Line1v)
visProperties1.SetRealLineType 1, 1
visProperties1.SetRealWidth 1, 1
selection1.Clear

Set Text1 = drawingView1.Texts.Add(textvert & X1, X1, Y2 + 20)
Text1.SetFontSize 0, 0, 5


'VertikaleLinien erzeugen

Dim linex As Single
Dim i
i = 1
linex = abstand
Do While (linex < X2 - X1)
    Set Linev = o2DFactory.CreateLine(X1 + linex, Y1 - 10, X1 + linex, Y2)
    selection1.Add (Linev)
    'Linienstärke erzeugte
    visProperties1.SetRealLineType 1, 1
    visProperties1.SetRealWidth 1, 1
    Set Text = drawingView1.Texts.Add(textvert & (X1 + linex), X1 + linex, Y2 + 20)
    Text.SetFontSize 0, 0, 5
    linex = linex + abstand
    i = i + 1
Loop

Set Line1h = o2DFactory.CreateLine(X1 - 10, Y1, X2, Y1)
selection1.Clear
selection1.Add (Line1h)
visProperties1.SetRealLineType 1, 1
visProperties1.SetRealWidth 1, 1
selection1.Clear
Set Text = drawingView1.Texts.Add(texthor & Y1, X1 - 40, Y1)
Text.SetFontSize 0, 0, 5

Dim liney As Single
Dim k
k = 1
liney = abstand

Do While (liney < Y2 - Y1)
    Set Linev = o2DFactory.CreateLine(X1 - 10, Y1 + liney, X2, Y1 + liney)
    selection1.Add (Linev)
    visProperties1.SetRealLineType 1, 1
    visProperties1.SetRealWidth 1, 1
    Set Text = drawingView1.Texts.Add(texthor & (Y1 + liney), X1 - 40, Y1 + liney)
    Text.SetFontSize 0, 0, 5
    liney = liney + abstand
    k = k + 1
Loop
'visProperties1.SetRealLineType 1, 1
'VisProperties.SetRealWidth 1, 1
selection1.Clear

iErr = Err.Number
    If (iErr <> 0) Then
        MsgBox (Err.Description)
        Exit Sub
    End If
   


End Sub

________________________________________

[Diese Nachricht wurde von wootpecker am 05. Aug. 2014 editiert.]

[Diese Nachricht wurde von wootpecker am 05. Aug. 2014 editiert.]

[Diese Nachricht wurde von wootpecker am 05. Aug. 2014 editiert.]

[Diese Nachricht wurde von wootpecker am 05. Aug. 2014 editiert.]

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

joehz
Mitglied
Freiberuflicher Konstrukteur


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

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: 05. Aug. 2014 19:43    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 wootpecker 10 Unities + Antwort hilfreich

Hallo wootpecker,

ich hab die Nachricht hier zum Anlass genommen und mir mal das Makro im 'Kochbuch' von Hr. Hansen angeschaut.
Nachdem ich theoretisch die Lösung zu deinem Problem schon hatte, hab ich's dann auch gleich eingearbeitet.
Nachdem das Wetter eh' mies war, hab ich dann noch 'n bisschen weiter programmiert.
Das Ergebnis ist jetzt fertig. Ich stelle das Makro noch in einem eigenen Thread vor.
Vorab erstmal die zwei Haupt-Routinen.

Viel Spass damit :-)

Tschau,
Joe

PS: Die Formatierung geht durch den chicen Font leider vor die Hunde.

'---------------------------------------------------------------------------------------
' Procedure : DrawViewNet
' Author    : jherzog
' Date      : 05.08.2014
' Time      : 16:06
' Languages : VB6 Pro
' V5-Release: V5R19/21
' Purpose  : Add vert/horiz lines to drawing views
' Parms    : strView  'the view to work on
'          : iLnDist  'the distance between net lines
'          : dFtSize  'the font size
'          : strFtName 'the font name
'
' Ret. Value: -
'
' Syntax    : DrawViewNet drViewObject, 100, 7.0, "SYM1"
'
'
'---------------------------------------------------------------------------------------
'
Sub DrawViewNet(strView As String, iLnDist As Integer, dFtSize As Double, strFtName As String)
  Dim strMsg As String
'  Dim oAD As Object 'Active Document      'public var
  Dim oSel ' As Selection
  Dim oSelVisProps As VisPropertySet
  Dim strRet 'As String
  Dim dblPtInd_01(1) ' As Double; point coordinates
  Dim dblPtInd_02(1) ' As Double
  Dim drShts As DrawingSheets
  Dim drSht As DrawingSheet
  Dim drVws As DrawingViews
  Dim drVw ' As DrawingView
  Dim oFact2D As Factory2D
 
  Dim Xn As Double                          'normalen-vektor
  Dim Yn As Double                          'in normalenform
  Dim Zn As Double
 
  Dim strH_Coord As String
  Dim strV_Coord As String
 
  Dim iX1                                  'schnittpunkt koordinaten
  Dim iX2
  Dim iY1                                  'der linien
  Dim iY2
 
  Dim oLnHorz ' As Line2D                  'erzeugtes linienobjekt
  Dim oLnVert ' As Line2D                  'erzeugtes linienobjekt
 
  Dim iTxtDist As Integer                  'abstand koordinate zur linie
  Dim strText As DrawingText                'koordinaten-string
 
  Dim oAW As Window                        'active window
  Dim oAV As Viewer                        'active viewer
  Dim oVP2D As Viewpoint2D
 
  Dim iLnOverRunLeft As Integer            'überlauf der Netzlinie über den Schnittpunkt hinaus
  Dim iLnOverRunBottom As Integer
  Dim iLnOverRunRight As Integer
  Dim iLnOverRunTop As Integer
 
  Dim iAnchorPosV As CatTextAnchorPosition  'text anchor pos for the vertical lines
  Dim iAnchorPosH As CatTextAnchorPosition  'text anchor pos for the horizontal lines
  Dim iLR As Integer                        'the direction vector indicating swap L-R
  Dim iTB As Integer                        'the direction vector indicating swap top-bottom
 
  Dim n As Integer
 
'--------------------------------------------------------------------------------------------------
  On Error GoTo DrawViewNet_Error

  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Clear

'  CATIA.Visible = False                    'nützt unter vb6 leider nix
 
'view active setzen
  Set drShts = oAD.Sheets
  Set drSht = drShts.ActiveSheet

  Set drVws = drSht.Views
  Set drVw = drVws.Item(strView)
  drVw.Activate

  Set oAW = CATIA.ActiveWindow
  Set oAV = oAW.ActiveViewer
  Set oVP2D = oAV.Viewpoint2D
 
  oSel.Add (drVw)
  CATIA.StartCommand "Reframe On"          'come to papa
  SleepEx 1000, False                      'wait for reframing
  CATIA.StartCommand "Zoom Out"            'just a bit smaller
 
'  CATIA.Visible = True                    'show the main window

  oSel.Clear
  AppActivate "CATIA", False                'switch to catia

  'get indicates
  strRet = oAD.Indicate2D("Indicate inner corner!", dblPtInd_01)
  If (strRet = "Cancel") Then
      MyMsgBox "Macro aborted!", vbOKOnly Or vbCritical, "DrawViewNet"
      Exit Sub
  End If

  strRet = oAD.Indicate2D("Indicate outer corner!", dblPtInd_02)
  If (strRet = "Cancel") Then
      MyMsgBox "Macro aborted!", vbOKOnly Or vbCritical, "DrawViewNet"
      Exit Sub
  End If

  CATIA.RefreshDisplay = False              'i don't think this helps
 
'----------------------------------------------------------------
'das makro versagt bisher bei nicht systemparallelen Ansichten;
'der winkel, unter dem die ansicht aufgebaut wurde, wird nicht berücksichtigt
'vielleicht über multiviewprojection realisieren?
'----------------------------------------------------------------
  drVw.GenerativeBehavior.GetProjectionPlaneNormal Xn, Yn, Zn    'normalen vektor ermitteln
  'Debug.Print Xn, Yn, Zn
 
  'Werte für Ansicht entstanden aus um 36.56° gegenüber YZ geneigten Ebene der Bottom View(XZ)
  '0                          -1                          0
  '0,803182346975866          -1,11022302462516E-16        0,59573326036603
  'arctan(0,595733/0,803182) = 36,564922°
 
  'Werte für Ansicht entstanden aus um 45° gegenüber XY(XZ) geneigten Ebene der Bottom View(YZ)
  '1                          0                          0
  '8,32667268468868E-17      -0,707106781186548          -0,707106781186548
 
  If Abs(Xn) = 1 Then
      strH_Coord = "Y"
      strV_Coord = "Z"
  ElseIf Abs(Yn) = 1 Then
      strH_Coord = "X"
      strV_Coord = "Z"
  ElseIf Abs(Zn) = 1 Then
      strH_Coord = "X"
      strV_Coord = "Y"
  Else                                            'nicht system parallel; nicht bearbeiten
'*** TODO ***
      strMsg = "View not normal to system axis. Can't compute net!"
      MyMsgBox strMsg, vbOKOnly Or vbCritical, "DrawViewNet"
      Exit Sub
  End If
 
'beispiel-werte
'  dblPtInd_01(0)      dblPtInd_01(1)    dblPtInd_02(0)    dblPtInd_02(1)
'  x1                  y1                x2                y2
'-17,3313598632813  -37,9861755371094  90,4266662597656  32,0358276367188
 

' over-              over-
'  run                run
'  x1                  x2
'
'      |            |  °    overrun y2
'      |            |  ind2
'      |            |
'  ---------------------- iy2
'      |            |
'      |            |
'      |            |
'      |            |
'  ---------------------- iy1
' ind1 |            |
'  °  |            |        overrun y1
'    ix1          ix2
 
  'calc the overrun
  iLnOverRunLeft = Abs(dblPtInd_01(0) Mod iLnDist)    'left
  iLnOverRunBottom = Abs(dblPtInd_01(1) Mod iLnDist)  'bottom
  iLnOverRunRight = Abs(dblPtInd_02(0) Mod iLnDist)    'right
  iLnOverRunTop = Abs(dblPtInd_02(1) Mod iLnDist)      'top
 
  'and the crossings
  iX1 = (dblPtInd_01(0) \ iLnDist) * iLnDist
  iY1 = (dblPtInd_01(1) \ iLnDist) * iLnDist
  iX2 = (dblPtInd_02(0) \ iLnDist) * iLnDist
  iY2 = (dblPtInd_02(1) \ iLnDist) * iLnDist
 
  'the code was based on x1 < x2 and y1 < y2
  'so if that is not the case, we need to adjust
  '
  If iX1 < iX2 Then                'the "standard" case
      iLR = 1
      iAnchorPosH = catMiddleLeft
  End If
  If iX1 > iX2 Then                'swap LR
      iLR = -1
      iAnchorPosH = catMiddleRight
  End If
  If iY1 < iY2 Then                'the "standard" case
      iTB = 1
      iAnchorPosV = catBottomCenter
  End If
  If iY1 > iY2 Then                'swap top - bottom
      iTB = -1
      iAnchorPosV = catTopCenter
  End If
 
  Set oSelVisProps = oSel.VisProperties
  Set oFact2D = drVw.Factory2D
  iTxtDist = 2 / drVw.Scale2
 
  '--------------------------------------------------------------
  'create the vertical lines
  For n = iX1 To iX2 Step (iLR * iLnDist)
      Set oLnVert = oFact2D.CreateLine(n, iY1 - (iTB * iLnOverRunBottom), n, iY2 + (iTB * iLnOverRunTop))
      oLnVert.Name = "NET_" & oLnVert.Name                                    'change the name for handling later
     
      'change the line props
      oSel.Clear
      oSel.Add (oLnVert)
      oSelVisProps.SetRealLineType 1, 1
      oSelVisProps.SetRealWidth 1, 1
      If frmNetzlinien_SO.ckBxFix.Value = 1 Then CATIA.StartCommand "Fix"    'fix lines if box checked
      If frmNetzlinien_SO.cboLayer.ListIndex <> 0 Then                        'adjust layer
        oSelVisProps.SetLayer catVisLayerBasic, frmNetzlinien_SO.cboLayer.List(frmNetzlinien_SO.cboLayer.ListIndex)
      Else
        oSelVisProps.SetLayer catVisLayerNone, 999                          'or set to none
      End If
      oSel.Clear
     
      'label the line
      Set strText = drVw.Texts.Add(strV_Coord & n, n, iY2 + (iTB * iLnOverRunTop) + (iTB * iTxtDist))
      strText.SetFontSize 0, 0, dFtSize                                      'set font size
      strText.SetFontName 0, 0, strFtName                                    'and font
      strText.AnchorPosition = iAnchorPosV                                    'the anchor position
      strText.Name = "NET_" & strText.Name                                    'and rename
'*** TODO ***
      'linking the text to the line makes the text move, if the line is moved;
      'the text itself can still be movedon it's own
      'setting the link to 'rigid' would lock the text in place; info on 'rigid'???
      If frmNetzlinien_SO.ckBxFix.Value = 1 Then strText.AssociativeElement = oLnVert
  Next

  'horiizontal lines accordingly
  For n = iY1 To iY2 Step (iTB * iLnDist)
      Set oLnHorz = oFact2D.CreateLine(iX1 - (iLR * iLnOverRunLeft), n, iX2 + (iLR * iLnOverRunRight), n)
      oLnHorz.Name = "NET_" & oLnHorz.Name
     
      'change props
      oSel.Clear
      oSel.Add (oLnHorz)
      oSelVisProps.SetRealLineType 1, 1
      oSelVisProps.SetRealWidth 1, 1
      If frmNetzlinien_SO.ckBxFix.Value = 1 Then CATIA.StartCommand "Fix"
      If frmNetzlinien_SO.cboLayer.ListIndex <> 0 Then
        oSelVisProps.SetLayer catVisLayerBasic, frmNetzlinien_SO.cboLayer.List(frmNetzlinien_SO.cboLayer.ListIndex)
      Else
        oSelVisProps.SetLayer catVisLayerNone, 999
      End If
      oSel.Clear
     
      'add label
      Set strText = drVw.Texts.Add(strH_Coord & n, iX2 + (iLR * iLnOverRunRight) + (iLR * iTxtDist), n)
      strText.SetFontSize 0, 0, dFtSize
      strText.SetFontName 0, 0, strFtName
      strText.AnchorPosition = iAnchorPosH
      strText.Name = "NET_" & strText.Name
      If frmNetzlinien_SO.ckBxFix.Value = 1 Then strText.AssociativeElement = oLnHorz
  Next

  CATIA.RefreshDisplay = True                              'doesn't seem to help any

  On Error GoTo 0

Exit Sub
'--------------------------------------------------------------------------------------------------------------------
DrawViewNet_Error:
  Dim errMsg As String
  Dim errRet As VbMsgBoxResult

  Select Case Err.Number
'      Case 438
'      Case -2147467259
      Case Else
        errMsg = Err.Number & ": " & Err.Description & " in procedure DrawViewNet of Modul mod_Netzlinien_SO"
        errRet = MyMsgBox(errMsg, vbOKOnly, "DrawViewNet")
  End Select
 
  'Resume Next                                          'fall thru to quit sub
'--------------------------------------------------------------------------------
End Sub

'---------------------------------------------------------------------------------------
' Procedure : EraseViewNet
' Author    : jherzog
' Date      : 04.08.2014
' Time      : 10:42
' Languages : VB6 Pro
' V5-Release: V5R19/21
' Purpose  : Löscht vom makro drawnet erzeugte netze wieder
' Parms    : strView  : der Viewname
' Ret. Value: -
'
' Syntax    : EraseViewNet "Top View"
'
'
'---------------------------------------------------------------------------------------
'
Sub EraseViewNet(strView As String)
  Dim drShts As DrawingSheets
  Dim drSht As DrawingSheet
  Dim drVws As DrawingViews
  Dim drVw ' As DrawingView

  Dim drGEs As GeometricElements
  Dim drGE As GeometricElement
  Dim strText As DrawingText
 
  Dim oAW As Window                                  'active window
  Dim oAV As Viewer                                  'active viewer
  Dim oVP2D As Viewpoint2D

  Dim oSel ' As Selection
  Dim n As Integer
'-------------------------------------------------------------------------------
  Screen.MousePointer = vbHourglass                  '
  frmNetzlinien_SO.Enabled = False                  'don't push any more buttons
 
  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Clear
 
'view aktivieren und zentrieren
  Set drShts = oAD.Sheets
  Set drSht = drShts.ActiveSheet

  Set drVws = drSht.Views
  Set drVw = drVws.Item(strView)
  drVw.Activate                                      'view aktivieren
 
'zentrieren und auf bs skalieren
  Set oAW = CATIA.ActiveWindow
  Set oAV = oAW.ActiveViewer
  Set oVP2D = oAV.Viewpoint2D
 
  oSel.Add (drVw)
  CATIA.StartCommand "Reframe On"                    'reframe selected elements
  SleepEx 1000, False                                'wait for reframing
  CATIA.StartCommand "Zoom Out"                      'a bit smaller please
  oSel.Clear

'elemente löschen
  Set drGEs = drVw.GeometricElements                'zuerst die linien auswählen
  For n = drGEs.Count To 1 Step -1                  'rückwärts die items wegpflücken
      Set drGE = drGEs.Item(n)                        '
      If Left$(drGE.Name, 4) = "NET_" Then
        oSel.Add drGE
      End If
  Next
 
  For n = drVw.Texts.Count To 1 Step -1              'dann die texte
      Set strText = drVw.Texts.Item(n)
      If Left$(strText.Name, 4) = "NET_" Then
        oSel.Add strText
      End If
  Next
  If oSel.Count > 0 Then oSel.Delete                'alle löschen
  oSel.Clear                                        'fertig
 
  frmNetzlinien_SO.Enabled = True                    'jetzt darfst wieder spielen
  Screen.MousePointer = vbNormal

End Sub


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