Autor
|
Thema: Bewegen von Selection im FrameTitleBlock (743 mal gelesen)
|
C.Samer Mitglied CAD Administrator
Beiträge: 72 Registriert: 03.05.2017
|
erstellt am: 15. Dez. 2017 09:44 <-- editieren / zitieren --> Unities abgeben:
Hallöchen! Nächste Hürde Kann ich eine Selection (z.B. den Revision Block) in einem Drawing per Makro verschieben (Move-ähnlicher Befehl)? Code: oDrwSelection.Clear() oDrwSelection.Add(oDrwView) oDrwSelection.Search "Name=Frame_RevisionBlock_*,sel" If oDrwSelection.Count = 0 Then Exit Sub End If'oDrwSelection.Move x,y
Danke! Grüße, Christoph [Diese Nachricht wurde von C.Samer am 11. Jan. 2018 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: 15. Dez. 2017 09:53 <-- editieren / zitieren --> Unities abgeben: Nur für C.Samer
Servus Um was für ein Element bzw Elemente handelt es sich denn? ggf musst du für jedes Unterelement die Koordinaten anpassen (zB 2DPoint - SetData; 2D-Detail - x und y) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
C.Samer Mitglied CAD Administrator
Beiträge: 72 Registriert: 03.05.2017
|
erstellt am: 15. Dez. 2017 10:15 <-- editieren / zitieren --> Unities abgeben:
Es handelt sich um den Revisions-Block im Drawing, also "Linie" und "Text". An eine For-Schleife, welche jedes Element einzeln durchläuft, habe ich auch schon gedacht. Ich habe jedoch gehofft, dass es einen Befehl gibt, mit dem ich alle Elemente gleichzeitig verschieben kann Grüße, Christoph 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: 15. Dez. 2017 10:22 <-- editieren / zitieren --> Unities abgeben: Nur für C.Samer
Servus Scheint leider nicht anders zu gehen. Hier findest du noch einen anderen Lösung dazu (leider ändern sich dann die Namen der Elemente). Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
C.Samer Mitglied CAD Administrator
Beiträge: 72 Registriert: 03.05.2017
|
erstellt am: 15. Dez. 2017 11:17 <-- editieren / zitieren --> Unities abgeben:
|
C.Samer Mitglied CAD Administrator
Beiträge: 72 Registriert: 03.05.2017
|
erstellt am: 11. Jan. 2018 16:27 <-- editieren / zitieren --> Unities abgeben:
Achja, hier mein Code zum Verschieben der einzelnen Elemente meines TitleBlocks an die richtige Position: Code: Sub MoveTitleBlock() If bClosing = True Then Exit Sub End If oDrwSelection.Clear() oDrwSelection.Add(oDrwView) oDrwSelection.Search "Name=Frame_TitleBlock_*,sel" If oDrwSelection.Count = 0 Then oDrwSelection.Clear() Exit Sub End If oDrwSelection.Clear() oDrwSelection.Add(oDrwView) oDrwSelection.Search "Name=Frame_Border_Inside_Right,sel" If oDrwSelection.Count = 0 Then MsgBox "Right Line of Frame not found.", vbOkOnly, "AddRevisionBlock" oDrwSelection.Clear() bClosing = True Exit Sub End If Dim iFTBXPos As Long Dim iFTBYPos As Long Dim iFTBCoord(3) oDrwSelection.Item(1).Value.GetEndPoints(iFTBCoord) iFTBXPos = iFTBCoord(0) iFTBYPos = iFTBCoord(1) oDrwSelection.Clear() oDrwSelection.Add(oDrwView) oDrwSelection.Search "Name=Frame_TitleBlock_Line_Vertical_14,sel" If oDrwSelection.Count = 0 Then MsgBox "First Vertical Line of Title Block not found.", vbOkOnly, "AddRevisionBlock" oDrwSelection.Clear() bClosing = True Exit Sub End If Dim iTBXPos As Double Dim iTBYPos As Double Dim iTBCoord(3) oDrwSelection.Item(1).Value.GetEndPoints(iTBCoord) iTBXPos = iTBCoord(0) iTBYPos = iTBCoord(1) oDrwSelection.Clear() Dim iXDif As Long Dim iYDif As Long iXDif = iFTBXPos - (iTBXPos + 180) iYDif = iFTBYPos - iTBYPos If iXDif = 0 And iYDif = 0 Then Exit Sub End If oDrwSelection.Add(oDrwView) oDrwSelection.Search "Name=Frame_TitleBlock_*,sel" Dim iDrwSelectionCount As Long iDrwSelectionCount = oDrwSelection.Count Dim oCurCircle As Circle2D Dim iCurCenter(1) Dim iCurRadius Dim oCurPic As DrawingPicture Dim oCurText Dim oCurLine Dim iCurOrigin(1) Dim iCurDirection(1) For i = 1 To iDrwSelectionCount Select Case TypeName(oDrwSelection.Item(i).Value) Case "DrawingText" Set oCurText = oDrwSelection.Item(i).Value oCurText.X = oCurText.X + iXDif oCurText.Y = oCurText.Y + iYDif Case "Line2D" Set oCurLine = oDrwSelection.Item(i).Value oCurLine.GetOrigin(iCurOrigin) oCurLine.GetDirection(iCurDirection) oCurLine.SetData iCurOrigin(0) + iXDif, iCurOrigin(1) + iYDif, iCurDirection(0), iCurDirection(1) Case "Circle2D" Set oCurCircle = oDrwSelection.Item(i).Value oCurCircle.GetCenter(iCurCenter) iCurRadius = oCurCircle.Radius oCurCircle.SetData iCurCenter(0) + iXDif, iCurCenter(1) + iYDif, iCurRadius Case "DrawingPicture" Set oCurPic = oDrwSelection.Item(i).Value oCurPic.X = oCurPic.X + iXDif oCurPic.Y = oCurPic.Y + iYDif End Select Next oDrwSelection.Clear() End Sub
Vielleicht hilft es ja in der Zukunft jemandem Grüße aus Wien, Christoph
[Diese Nachricht wurde von C.Samer am 11. Jan. 2018 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |