Continue to Site
Sub CATMain()
Dim oPartDoc As Part
Set oPartDoc = CATIA.ActiveDocument.Part
Dim sSel As Selection
Set sSel = CATIA.ActiveDocument.Selection
'multiple geosets are selected
Dim oCurveGeoset 'as HybridBody 'Geoset that has all the curves
Dim oPointGeoset 'as HybridBody 'New geoset for the points on the curves, I am just guessing that you want this
Dim oCurve 'curve points will be added to
'Dim sResponse 'The number of points you want on the curves
Dim iCounter 'To make sure you dont get into an infinite loop
Dim oPoint As HybridShapePointOnCurve
Dim oGSD 'As Factory 'for accessing Generative shape design functions
Dim lRatio 'Ratio for spacing out points
Set oGSD = oPartDoc.HybridShapeFactory
'loop through selected geosets to get curves
For I = 1 To sSel.Count
Set oCurveGeoset = sSel.Item(I).Value
'You need to know how many points to put on the curves
'This will ask the user once for each geoset
'Maybe you want to do it automatically...maybe you have a standard
'Like you want a point every 1 mm on every curve
sResponse = "A" 'set to a non-number to get inside of the following Do Loop
iCounter = 0 'Used to limit the number of tries the user gets to enter a number
Do Until IsNumeric(sResponse) = True And Val(sResponse) = Int(Val(sResponse)) 'Make sure user enters a number that is not a decimal
sResponse = InputBox("Enter the (integer) number of points to be placed on each curve in this geoset")
If iCounter = 3 Then 'give user 3 chances to enter a number
MsgBox "You did not enter an integer, exiting"
Exit Sub
End If
iCounter = iCounter + 1 'Increments the counter if user keeps putting in non numbers
Loop
'Calculate ratio
lRatio = 1 / (CInt(sResponse) - 1)
Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
oPointGeoset.Name = "Points for " & oCurveGeoset.Name 'name the geoset
'loop through curves to add Points
For j = 1 To oCurveGeoset.HybridShapes.Count
Set oCurve = oCurveGeoset.HybridShapes.Item(j)
' Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
' oPointGeoset.Name = "Points for " & oCurve.Name 'name the geoset
'If you name the point geosets a specific way with this macro, you can get them automatically
'When you create the text file, you won't need to select them;)
'Loop to add points at multiples of the calculated ratio
For k = 0 To CInt(sResponse) - 1
Set oPoint = oGSD.AddNewPointOnCurveFromPercent(oCurve, k * lRatio, False) 'Add the point
oPoint.Name = oCurve.Name & " Point " & k + 1 'name the point
oPointGeoset.AppendHybridShape oPoint 'Make the point appear in the tree
oPoint.Compute
Next
Next
Next
sSel.Clear 'Clear the selection
End SubSub CATMain()
Dim filename As String
filename = CATIA.ActiveDocument.Name
Dim sPath As String
sPath = "C:\Users\SOMEUSER\Desktop"
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim oPartDoc As Part
On Error Resume Next
Set oPartDoc = CATIA.ActiveDocument.Part
If Err.Number <> 0 Then
Message = MsgBox("Sorry, This script works with a CATPart as Active document", vbCritical, "Error")
Exit Sub
End If
' What do want to select
Dim EnableSelectionFor(0)
EnableSelectionFor(0) = "HybridBodies"
' Reset the Selection
Set sSel = CATIA.ActiveDocument.Selection
sSel.Clear
' Define Selection
Dim sMessage 'as string
sMessage = "Please select Geometrical Set(s) with points to extract" 'Set variable as message to use in msgbox and selectelement3:)
MsgBox sMessage
UserSelection = sSel.SelectElement3(EnableSelectionFor, sMessage, False, CATMultiSelTriggWhenUserValidatesSelection, True)
' Evaluation if the selection is correct or not
If UserSelection <> "Normal" Then 'Technically this will never happen because your filter forces them to pick a geoset
MsgBox "Error with the selection"
Exit Sub
Else
'Make an array to store the geosets in
'You need to subtract 1 because arrays start at 0 not 1, but selections start at 1
ReDim aGeosets(sSel.Count - 1)
'Loop through geosets and store in array
For I = 1 To sSel.Count
Set aGeosets(I - 1) = sSel.Item(I).Value
Next
'Set ohybridbody = sSel.Item(1).Value
'MsgBox "The Geometrical Set selected is : " & ohybridbody.Name
End If
ReDim acoord(2) 'Do you need to redim acoord or can you just size it when you dim it? Like "Dim aCoord(2)"
'--------------------------------------------------------------------------------
' The location of the result file
'--------------------------------------------------------------------------------
'Dim filename As String
'filename = CATIA.FileSelectionBox("Where do you want to save the result file", "*.txt", CatFileSelectionModeSave)
'Datos = CATIA.FileSystem.CreateFile(path & "\" & CATIA.ActiveDocument.Name & ".txt", True)
'Set ostream = Datos.OpenAsTextStream("ForAppending")
sFileLocation = sPath & "\" & CATIA.ActiveDocument.Name & ".txt"
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ostream = oFSO.CreateTextFile(sFileLocation, True)
'Header
ostream.WriteLine (oPartDoc.Name)
ostream.WriteLine (" ") 'Blank line
'ostream.Write ("The selected Geometrical Set was : " & ohybridbody.Name & Chr(10))
ostream.WriteLine (" ") ' Blank line
Dim ohybridbody As HybridBody
'start Loop to go through Goesets
For I = 0 To UBound(aGeosets)
Set ohybridbody = aGeosets(I) 'Can't remember if this is aGeosets(i).value or not :(
Set oshapes = ohybridbody.HybridShapes
ostream.WriteLine ("$* PLY" & Chr(32) & ohybridbody.Name & Chr(10)) 'First line in your picture
ostream.WriteLine ("PENUP") ' Second line in your picture
'Get point coordinates from all points in geoset
For j = 1 To oshapes.Count
oshapes.Item(j).GetCoordinates acoord
Set reference1 = oshapes.Item(j) 'Doesn't appear to be used, can it be deleted?
Dim formatednumber(2)
For k = 0 To 2
formatednumber(k) = Int(acoord(k) * 10) / 10
If Int(acoord(k) * 10) / 10 - Int(acoord(k)) = 0 Then
formatednumber(k) = Int(acoord(k)) & ".0"
End If
Next
'Thrid and fifth+ lines in your picture
ostream.WriteLine ("GOTO " & Chr(32) & formatednumber(0) & Chr(32) & "" & Chr(32) & formatednumber(1) & Chr(32) & "" & Chr(32) & formatednumber(2) & Chr(10))
If j = 1 Then
ostream.WriteLine ("PENDOWN") 'Fourth line in your picture
End If
'Just an idea, Instead of making a new array, you should be able to change the contents of the existing array
' For k = 0 To 2
' acoord(k) = Int(acoord(k) * 10) / 10
' If Int(acoord(k) * 10) / 10 - Int(acoord(k)) = 0 Then
' acoord(k) = Int(acoord(k)) & ".0"
' End If
' Next
'You would also need to change when you write to the text stream
'ostream.Write ("GOTO " & Chr(32) & acoord(0) & Chr(32) & "" & Chr(32) & acoord(1) & Chr(32) & "" & Chr(32) & acoord(2) & Chr(10))
Next 'goes to next point
ostream.WriteLine ("PENUP") 'Last line in your picture
Next 'goes to next geoset
ostream.Close
'MsgBox "Points Exported :" & (i-1) & " POINTS" & Chr(10) & Chr(10) & "Please Check the following file for result : " & chr(10) & chr(10) & filename & chr(10)& chr(10) & "Process finished"
MsgBox "Check results in folder " & Chr(10) & path & "\" & Chr(10) & Chr(10) & "File:" & Chr(10) & partDoc.Name & ".txt" & Chr(10)
End SubSub CATMain()
Dim oPartDoc As Part
Set oPartDoc = CATIA.ActiveDocument.Part
Dim sSel As Selection
Set sSel = CATIA.ActiveDocument.Selection
'multiple geosets are selected
Dim oCurveGeoset 'as HybridBody 'Geoset that has all the curves
Dim oPointGeoset 'as HybridBody 'New geoset for the points on the curves, I am just guessing that you want this
Dim oCurve 'curve points will be added to
'Dim sResponse 'The number of points you want on the curves
Dim iCounter 'To make sure you dont get into an infinite loop
Dim oPoint As HybridShapePointOnCurve
Dim oGSD 'As Factory 'for accessing Generative shape design functions
Dim lRatio 'Ratio for spacing out points
Set oGSD = oPartDoc.HybridShapeFactory
[COLOR=#4E9A06][b]'Move geoset creation out of the loop to only make one geoset
Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
oPointGeoset.Name = "Points for " & oCurveGeoset.Name 'name the geoset[/b][/color]
'loop through selected geosets to get curves
For I = 1 To sSel.Count
Set oCurveGeoset = sSel.Item(I).Value
'You need to know how many points to put on the curves
'This will ask the user once for each geoset
'Maybe you want to do it automatically...maybe you have a standard
'Like you want a point every 1 mm on every curve
sResponse = "A" 'set to a non-number to get inside of the following Do Loop
iCounter = 0 'Used to limit the number of tries the user gets to enter a number
Do Until IsNumeric(sResponse) = True And Val(sResponse) = Int(Val(sResponse)) 'Make sure user enters a number that is not a decimal
sResponse = InputBox("Enter the (integer) number of points to be placed on each curve in this geoset")
If iCounter = 3 Then 'give user 3 chances to enter a number
MsgBox "You did not enter an integer, exiting"
Exit Sub
End If
iCounter = iCounter + 1 'Increments the counter if user keeps putting in non numbers
Loop
'Calculate ratio
lRatio = 1 / (CInt(sResponse) - 1)
[COLOR=#A40000][b]' Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
' oPointGeoset.Name = "Points for " & oCurveGeoset.Name 'name the geoset[/b][/color]
'loop through curves to add Points
For j = 1 To oCurveGeoset.HybridShapes.Count
Set oCurve = oCurveGeoset.HybridShapes.Item(j)
' Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
' oPointGeoset.Name = "Points for " & oCurve.Name 'name the geoset
'If you name the point geosets a specific way with this macro, you can get them automatically
'When you create the text file, you won't need to select them;)
'Loop to add points at multiples of the calculated ratio
For k = 0 To CInt(sResponse) - 1
Set oPoint = oGSD.AddNewPointOnCurveFromPercent(oCurve, k * lRatio, False) 'Add the point
oPoint.Name = oCurve.Name & " Point " & k + 1 'name the point
oPointGeoset.AppendHybridShape oPoint 'Make the point appear in the tree
oPoint.Compute
Next
Next
Next
sSel.Clear 'Clear the selection
End Sub
sorry about that...that is what happens when you can't test your code. if you remove the mane of the curve geoset from the name of the point geoset, it will work.[COLOR=#4E9A06]'Move geoset creation out of the loop to only make one geoset
Set oPointGeoset = oPartDoc.HybridBodies.Add 'Add the geoset
oPointGeoset.Name = "Points for 3D Printing Extract" '& oCurveGeoset.Name 'name the geoset[/color]Set hybridBody2 = hybridBodies1.add()
hybridBody2.Name = "GENERATED CURVES & i"
GeoSel.Search "Topology.CGMEdge,sel"
For n = 1 To GeoSel.Count
Set mySel1 = GeoSel.Item(n)
Set oCrvRef = mySel1.Reference
miLongitud = Len(mySel1.Reference.Name)
strTmp = Right(mySel1.Reference.Name, miLongitud - 21)
miLongitud = Len(strTmp)
Texto = Left(strTmp, miLongitud - 1)
Set oRefCurva = oPart.CreateReferenceFromBRepName(Texto, mySel1.Value)
Set oCurva = oHSF.AddNewCurveDatum(oRefCurva)
oCurva.Compute
hybridBody2.AppendHybridShape oCurva
Next
End If