JKimmel
Guest
|
 Posted:
Fri Nov 11, 2005 9:10 pm Post subject:
Re: POINT INPUT FROM EXCEL |
|
|
tjones2@kcp.com wrote:
| Quote: | Anyone know how to input spline points from an excel file that has X, Y
Z coordinates listed.
From what I understand, you start by saving this as a .txt file but how
do you read it into an open sketch? Any help would be appreciated.
|
This is a macro called "ptcloud". It reads a text file with points
listed as:
x
y
z
x
y
z...etc
and enters them into a sketch. I've tried it and it works, but I've
forgotten how. Can somebody please provide instructions? Thanks.
Option Explicit
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim fs As Object
Dim file As Object
Type Point
x As Double
y As Double
z As Double
End Type
Dim oldY As Double
Dim pt As Point
Dim SelectionPoints As New Collection
Dim line As String
Dim first As Boolean
Dim i As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.OpenTextFile("C:\data.xyz")
line = file.ReadLine()
swApp.ActiveDoc.ActiveView.FrameState = 1
oldY = 0
first = True
Do While file.AtEndOfStream <> True And line <> ""
Dim p1 As Long
Dim p2 As Long
p1 = InStr(line, Chr(9))
pt.x = CDbl(Mid(line, 1, p1 - 1)) / 25000
p2 = InStr(p1 + 1, line, Chr(9))
pt.y = CDbl(Mid(line, p1 + 1, p2 - p1 - 1)) / 25000
pt.z = CDbl(Mid(line, p2 + 1)) / 250
If first Or pt.y <> oldY Then
oldY = pt.y
If Not first Then Part.InsertCurveFileEnd
Part.InsertCurveFileBegin
SelectionPoints.Add pt.x
SelectionPoints.Add pt.y
SelectionPoints.Add pt.z
first = False
End If
Part.InsertCurveFilePoint pt.x, pt.y, pt.z
line = file.ReadLine()
Loop
Part.InsertCurveFileEnd
file.Close
Part.ClearSelection2 True
For i = 1 To SelectionPoints.Count / 3
Dim name As String
name = "Curve" + Trim(Str(i))
boolstatus = Part.Extension.SelectByID(name, "REFERENCECURVES",
SelectionPoints(i * 3 - 2), _
SelectionPoints(i * 3 - 1), SelectionPoints(i * 3), True, 1,
Nothing)
Next i
Part.InsertLoftRefSurface2 False, False, False, 1, 0, 0
End Sub
--
J Kimmel
myname@whereIwork.com
www.metalinnovations.com
"Cuius testiculos habes, habeas cardia et cerebellum." - When you have
their full attention in your grip, their hearts and minds will follow.
|
|
FAQ
Memberlist
Register
Profile
Log in to check your private messages
Log in