Code:
Sub CATMain()Dim oMyPartDocument
Dim oMyPart
Dim oMySel
Dim sFilter(0)
Dim sSelection
Dim sFehler
Dim oCount
Dim izaehler
Dim oPunkt(1000)
Dim oName(1000)
Dim oDatei
Dim cDateiPfad
Dim fFileExist
Dim dStrom
Dim oEingabe
Dim oAxisSystem as AxisSystem
Dim aCoord1(2)
Dim aCoord2(2)
Dim Vx_A(2)
Dim Vy_A(2)
Dim Vz_A(2)
Dim xa
Dim ya
Dim za
Dim x
Dim y
Dim z
Dim xp
Dim yp
Dim zp
Dim oPoint
oEingabe="d:\temp\"
oEingabe=InputBox("Bitte den Dateipfad angeben:","Eingabe Dateipfad",oEingabe)
cDateiPfad=oEingabe
oEingabe="Punktkoordinaten.csv"
oEingabe=InputBox("Bitte den Dateinamen angeben:","Eingabe Dateiname",oEingabe)
cDateiName=oEingabe
On Error Resume Next
CATIA.FileSystem.GetFile(cDateiPfad&cDateiName)
fFileExist=Err.Number
On Error Goto 0
If fFileExist<> 0 Then
Set oDatei=CATIA.FileSystem.CreateFile(cDateiPfad&cDateiName,False)
Else
Set oDatei=CATIA.FileSystem.GetFile(cDateiPfad&cDateiName)
End If
Set oMySel=CATIA.ActiveDocument.Selection
If oMySel.Count2>0 Then
oCount=oMySel.Count2
For iZaehler=1 To oCount
Set oPunkt(iZaehler)=oMySel.Item2(iZaehler).Value
oName(iZaehler)=oMySel.Item2(iZaehler).Value.Name
Next
Else
MsgBox("Es sind noch keine Punkte selektiert worden!"&CHR(13)&"Bitte Punkte selektieren!")
sFilter(0)="Point"
sFehler=0
iZaehler=0
Do
oMySel.Clear
sSelection=oMySel.SelectElement2(sFilter,"Bitte Punkt "&iZaehler+1&" auswählen!",True)
If sSelection="Normal" Then
iZaehler=iZaehler+1
Set oPunkt(iZaehler)=oMySel.Item2(1).Value
oName(iZaehler)=oMySel.Item2(1).Value.Name
sFehler=0
Else
oCount=iZaehler
sFehler=1
End If
Loop Until sFehler=1
End If
If oCount=0 Then
MsgBox("Es wurden keine Punkte ausgewählt!"&CHR(13)&"Das Macro wird hier beendet!")
Exit Sub
End If
MsgBox("Bitte das Achsensystem anklicken, auf welches sich die Koordinaten beziehen sollen!")
oMySel.Clear
sFilter(0)="AxisSystem"
sSelection=oMySel.SelectElement2(sFilter,"Bitte das Achsensystem anklicken,auf welches sich die Koordinaten bezihen sollen",True)
If sSelection="Normal" Then
Set oAxisSystem=oMySel.Item2(1).Value
End If
oAxisSystem.GetOrigin aCoord2
oAxisSystem.GetXAxis Vx_A
oAxisSystem.GetYAxis Vy_A
oAxisSystem.GetZAXis Vz_A
oBox=MsgBox("Sollen die Komazeichen gegen Dezimalzeichen ersetzt werden?",4,"Komazeichen ersetzen")
Set dStrom=oDatei.OpenAsTextStream("ForAppending")
dStrom.Write("START"&CHR(10))
dStrom.Write("Element"&";"&"X-Koordinate"&";"&"Y-Koordinate"&";"&"Z-Koordinate"&CHR(10))
For iZaehler=1 To oCount
set oPoint=oPunkt(iZaehler)
oPoint.GetCoordinates aCoord1
xa=aCoord2(0)
ya=aCoord2(1)
za=aCoord2(2)
x=aCoord1(0)
y=aCoord1(1)
z=aCoord1(2)
xp=Vx_A(0)*(x-xa)+Vx_A(1)*(y-ya)+Vx_A(2)*(z-za)
yp=Vy_A(0)*(x-xa)+Vy_A(1)*(y-ya)+Vy_A(2)*(z-za)
zp=Vz_A(0)*(x-xa)+Vz_A(1)*(y-ya)+Vz_A(2)*(z-za)
xp=Round(xp,3)
yp=Round(yp,3)
zp=Round(zp,3)
If oBox=6 Then
xp=Replace(xp,",",".")
yp=Replace(yp,",",".")
zp=Replace(zp,",",".")
End If
dStrom.Write(oName(iZaehler)&";"&xp&";"&yp&";"&zp&CHR(10))
Next
dStrom.Write("ENDE"&CHR(10)&CHR(10)&CHR(10))
dStrom.Close
MsgBox("Datei wurde erzeugt und kann in Excel importiert werden!")
End Sub
Foren auf CAD.de (alle Foren)
| 
