---

Hallo Zusammen

ich habe über selestion.add verschiedene Elemente (Linien, Punkte und Texte) Selectiert.
nun möchte ich diese um, sagen wir z.B. 50mm in X versieben.

Ich bekomme einfach keinen Code zusammen.
kann mir jemand mit einem Code helfen?

MfG Hokay

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

---

Hallo Zusammen,

..... hat niemenad eine Idee?
Oder ist die Aufgabe so schwierig, dass sich niemand traut?

MfG Hokay

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

---

hallo hokay,

poste erstmal deinen bisheriegen code-ansatz.
so ist es dann einfach zu helfen.

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

---

Hallo Hokay,

wenn es nur um die Idee geht, wie wäre es mit:

Code:

---

iSelection.Item(I).Move.Apply Array(1, 0, 0, 0, 1, 0, 0, 0, 1, 50, 0, 0)

---

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

---

Verschiebung.zip

Hallo Gemeinde
vielen dank für Eure Hilfe

Das ist mein Code:
Aber der steigt in Zeile 54 mit: "object unterstütze die Methode nicht" aus.

----------------------------------------------------------------
Sub CATMain()

'On Error Resume Next

Versatz_X = 50
Versatz_Y = 0

'--> --> --> --> --> --> --> --> --> --> --> --> -->
'Funktionsaufruf - Schriftfeld Beiwerk Verschieben
SFversatz Versatz_X,Versatz_Y

End Sub

'=======================================================================================
Function SFversatz (Versatz_X,Versatz_Y)
'=======================================================================================
MsgBox "Horizontaler Versatz = " & Versatz_X & "mm     Vertikaler Versatz = " & Versatz_Y & "mm"
Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection

'Funktionsaufruf - Elemente mit bestimmten Namen [siehe Liste] Suchen und selectieren
'--> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> -->
Liste = "SchriftfeldLinie.1,SchriftfeldLinie.2,Linie.3,Linie.7,Linie.8,Linie.9,Linie.12,Linie.13,Linie.14"
Selektieren Liste

'Funktionsaufruf - Texte mit bestimmten Namen Suchen und selectieren
'--> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> -->
SelTxt "Text.27", "Dichte"
SelTxt "Text.28", "Gewicht"
SelTxt "Text.29", "Volumen"
SelTxt "Text.30", "cm3"
SelTxt "Text.31", "g"
SelTxt "Text.32", "cm3"
SelTxt "Text.37", "Rohteil"

SelTxt "Text.24", "Radien"
SelTxt "Text.33", "Wandstärke"
SelTxt "Text.34", "Konturen"
SelTxt "Text.35", "Entformschrägen"
SelTxt "Text.36", "Schleifzugabe"
SelTxt "Text.39", "Abmessungen"


MsgBox "Schriftfeldbeiwerk Selectiert    X-Verschiebung = " & Versatz_X & " noch einarbeiten",,selection1.count

for i = 1 to selection1.count
Msgbox i
selection1.Item(i).Move.Apply Array(1, 0, 0, 0, 1, 0, 0, 0, 1, Versatz_X, 0, 0)
next

End Function

'=======================================================================================
Function SelTxt(SuchText, iValue)
'=======================================================================================
'MsgBox "Funktion Textwert - Eingang: " & SuchText ,,iValue
'On Error Resume Next
Dim oDrawer As DrawingDocument
Dim oTexts As DrawingTexts
Dim oText As DrawingText
Dim NumOfTexts As Integer

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument

Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection

Set oDrawer = CATIA.ActiveDocument
Set oTexts = oDrawer.Sheets.ActiveSheet.Views.ActiveView.Texts
NumOfTexts = oTexts.Count
Text = ""
i = 1

Do
Set oText = oTexts.Item(i)
if InStr(oText.Text,iValue) and oText.Name = SuchText then
'MsgBox "Suchtext Name = " & oText.Name & "    Suchtext Wert = " & iValue
TextValue = oText.Text
selection1.add oText
Exit Function
End if
i = i + 1
Loop Until i = NumOfTexts + 1
End Function

'=======================================================================================
Function Selektieren(Liste)
'=======================================================================================
'On Error Resume Next
Dim drawingDocument1 As Document
Set oDoc = CATIA.ActiveDocument
Set oSheets = oDoc.Sheets
Set oSheet = oSheets.ActiveSheet
Set oViews = oSheet.Views
Set oView = oViews.Item(1)
oView.Activate
Set oSelection = Catia.ActiveDocument.Selection

Set drawingDocument1 = CATIA.ActiveDocument

Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection
Selection1.clear

For i = 1 To oView.GeometricElements.Count
    Set oldLn = oView.GeometricElements.Item(i)
    Ausgabe = InStr(1,Liste ,oldLn.name)
    'MsgBox oldLn.name,,Liste
    if oldLn.name = "Punkt.4" then
    Ausgabe = 0
    end if
    if Ausgabe <> 0 then
    Selection1.Add oldLn
'MsgBox "Anzahl selektierter Elemente = " & Selection1.Count,,oldLn.name
end if
Next

End function

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

Kann mir noch einmal jemand über den Berg helfen?
MFG Hokay

[Diese Nachricht wurde von Hokay am 27. Mrz. 2009 editiert.]

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

---

Hallo Hokay,

meine erste Idee ist leider ungeeignet, sie funktioniert nur im 3D!

Daher nun die für 2D: einfach den Inhalt der Selektion ausschneiden, in ein Detail packen, Detail einfügen, verschieben auflösen und löschen. Dein Code muss dann so lauten:[CODE]Sub CATMain()

'On Error Resume Next

Versatz_X = 50
Versatz_Y = 0

'--> --> --> --> --> --> --> --> --> --> --> --> -->
'Funktionsaufruf - Schriftfeld Beiwerk Verschieben
SFversatz Versatz_X,Versatz_Y

End Sub

'=======================================================================================
Function SFversatz (Versatz_X,Versatz_Y)
'=======================================================================================
MsgBox "Horizontaler Versatz = " & Versatz_X & "mm    Vertikaler Versatz = " & Versatz_Y & "mm"
Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection

'Funktionsaufruf - Elemente mit bestimmten Namen [siehe Liste] Suchen und selectieren
'--> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> -->
Liste = "SchriftfeldLinie.1,SchriftfeldLinie.2,Linie.3,Linie.7,Linie.8,Linie.9,Linie.12,Linie.13,Linie.14"
Selektieren Liste

'Funktionsaufruf - Texte mit bestimmten Namen Suchen und selectieren
'--> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> --> -->
SelTxt "Text.27", "Dichte"
SelTxt "Text.28", "Gewicht"
SelTxt "Text.29", "Volumen"
SelTxt "Text.30", "cm3"
SelTxt "Text.31", "g"
SelTxt "Text.32", "cm3"
SelTxt "Text.37", "Rohteil"

SelTxt "Text.24", "Radien"
SelTxt "Text.33", "Wandstärke"
SelTxt "Text.34", "Konturen"
SelTxt "Text.35", "Entformschrägen"
SelTxt "Text.36", "Schleifzugabe"
SelTxt "Text.39", "Abmessungen"


MsgBox "Schriftfeldbeiwerk Selectiert    X-Verschiebung = " & Versatz_X & " noch einarbeiten",,selection1.count

selection1.Cut
selection1.Clear

Dim activeSheet As DrawingSheet
Dim detailSheet As DrawingSheet
Dim activeView As DrawingView
Dim detailView As DrawingView
Dim tempComp As DrawingComponent

Set activeSheet = drawingDocument1.Sheets.activeSheet
Set activeView = activeSheet.Views.activeView

Set detailSheet = drawingDocument1.Sheets.AddDetail("TempDetails")
Set detailView = detailSheet.Views.Add("Transfer")
selection1.Add detailView
selection1.Paste

Set tempComp = activeView.Components.Add(detailView, CDbl(Versatz_X), CDbl(Versatz_Y))
tempComp.Explode

drawingDocument1.Sheets.Remove ("TempDetails")

End Function

'=======================================================================================
Function SelTxt(SuchText, iValue)
'=======================================================================================
'MsgBox "Funktion Textwert - Eingang: " & SuchText ,,iValue
'On Error Resume Next
Dim oDrawer As DrawingDocument
Dim oTexts As DrawingTexts
Dim oText As DrawingText
Dim NumOfTexts As Integer

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument

Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection

Set oDrawer = CATIA.ActiveDocument
Set oTexts = oDrawer.Sheets.ActiveSheet.Views.ActiveView.Texts
NumOfTexts = oTexts.Count
Text = ""
i = 1

Do
Set oText = oTexts.Item(i)
if InStr(oText.Text,iValue) and oText.Name = SuchText then
'MsgBox "Suchtext Name = " & oText.Name & "    Suchtext Wert = " & iValue
TextValue = oText.Text
selection1.add oText
Exit Function
End if
i = i + 1
Loop Until i = NumOfTexts + 1
End Function

'=======================================================================================
Function Selektieren(Liste)
'=======================================================================================
'On Error Resume Next
Dim drawingDocument1 As Document
Set oDoc = CATIA.ActiveDocument
Set oSheets = oDoc.Sheets
Set oSheet = oSheets.ActiveSheet
Set oViews = oSheet.Views
Set oView = oViews.Item(1)
oView.Activate
Set oSelection = Catia.ActiveDocument.Selection

Set drawingDocument1 = CATIA.ActiveDocument

Dim Selection1 As Selection
Set Selection1 = drawingDocument1.Selection
Selection1.clear

For i = 1 To oView.GeometricElements.Count
    Set oldLn = oView.GeometricElements.Item(i)
    Ausgabe = InStr(1,Liste ,oldLn.name)
    'MsgBox oldLn.name,,Liste
    if oldLn.name = "Punkt.4" then
    Ausgabe = 0
    end if
    if Ausgabe <> 0 then
    Selection1.Add oldLn
'MsgBox "Anzahl selektierter Elemente = " & Selection1.Count,,oldLn.name
end if
Next

End function

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 Lusilnie,
vielen Dank für Deine Antwort. Diesen Ansatzpunkt hatte ich ebenfalls bereits im Kopf. der hat nur einen Hacken.
Der Weg über ausschneiden -> Detail -> einfügen hat zur Folge, dass alle Elemente andere Namen bekommen. Führt mann das Macro zum 2x auf diesem Drawing aus, findet er die Elemente z.B. Text.27, Linie.1 usw. nicht mehr oder findet sogar falsche. Nämlich diese, die in der Zwischenzeit neu hinzu gekommen sind und automatisch obige Namen bekommen haben.

Ich müßte nun hingehen und alle eingefügten Elemente mühsam wieder umbenennen.

Gibt es den wirklich keien Möglichkeit die Elemente einfach zu verschieben???

MFG Heiko

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

---

Hallo,

wenn du die Namen der Elemente weisst, dann verschieb sie doch direkt ohne sie vorher in eine Selection zu packen.

Aus der Doku z.B.
NewYCoordinate = 5*25.4/1000
MyText.y =  NewYCoordinate

Für Linien/Punkte usw. gibt es ähnliche Methoden/Eigenschaften.
Ich habe sowas selber schon mal (erfolgreich) so gemacht.

------------------
MfG
Randle

! It's not a bug, it's a feature !

[Diese Nachricht wurde von Randle am 30. Apr. 2009 editiert.]

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