Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Public Filename As String
- Private Sub Browse_Click()
- 'Open File
- Mainform.Hide
- Filename = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
- If Filename <> "False" Then
- Application.Visible = False
- filenamebox.Value = Filename
- Else
- Application.Visible = False
- Filename = filenamebox.Value
- End If
- Mainform.Show
- End Sub
- Private Sub ClearButton_Click()
- Mainform.Hide
- ActiveWorkbook.Close (False)
- Application.Visible = False
- End Sub
- Private Sub OKButton_Click()
- 'Set Up Message Labels
- Title = "Information Message"
- 'Check for Entered Values
- If filenamebox.Value <> "" Then
- Workbooks.Open Filename:=Filename
- Application.Visible = False
- 'Start CATIA and add an Open body to the document
- 'Start_CATIA Not needed because you are in process with CATIA.
- Dim MyPartDocument As PartDocument
- Dim MyPart As Part
- Dim PointGeoSet As HybridBody
- Set MyPartDocument = CATIA.Documents.Add("Part")
- Set MyPart = MyPartDocument.Part
- Set PointGeoSet = MyPart.HybridBodies.Add()
- PointGeoSet.Name = "MyPoints"
- Mainform.Hide
- 'Read Point Data from file and create point in CATIA
- i = 2
- Do Until Worksheets("Sheet1").Range("a" & i).Value = ""
- x = Worksheets("Sheet1").Range("a" & i).Value
- y = Worksheets("Sheet1").Range("b" & i).Value
- z = Worksheets("Sheet1").Range("c" & i).Value
- 'call point creation sub
- CreateZYXPoint MyPart, PointGeoSet,x,y,z,cstr(i)
- i = i + 1
- Loop
- i = i - 2
- MsgBox i & " Points Created in New Part", , Title
- Else
- MsgBox "Enter a Filename", , Title
- End If
- ActiveWorkbook.Close (False)
- 'update part in Catia
- MyPart.Update
- Mainform.Show
- End Sub
- Private Sub UserForm_Initialize()
- If Worksheets("Filepath_Location").Range("a1").Value <> "" Then
- Filename = Worksheets("Filepath_Location").Range("a1").Value
- filenamebox.Value = Filename
- End If
- End Sub
- Sub CreateXYZPoint(TargetPart As Part, TargetGeometricalSet As HybridBody, _
- Xmm As Double, Ymm As Double, Zmm As Double, _
- PointCount As String)
- Dim HSFactory As HybridShapeFactory
- Dim NewPoint As Point
- 'get the factory
- Set HSFactory = TargetPart.HybridShapeFactory
- 'create the point with the factory
- Set NewPoint = HSFactory.AddNewPointCoord(Xmm, Ymm, Zmm)
- 'Append the point to the geometrical set
- TargetGeometricalSet.AppendHybridShape NewPoint
- 'rename the point
- NewPoint.Name = "Point." & PointCount
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement