CREATE POINTS ON CURVE
CREATE POINTS ON CURVE
(OP)
recording macro for creating points doesn't work for me, moreover marco records entities names. not good for me.
can anybody share sample macro for creating points on curve? needed for composites (laser projection)
thanks in advance.
can anybody share sample macro for creating points on curve? needed for composites (laser projection)
thanks in advance.





RE: CREATE POINTS ON CURVE
catscript
ostream.Write ("GOTO X" & Chr(0032) & acoord(0) & Chr(0009) & "Y" & Chr(0032) & acoord(1) & Chr(0009) & "Z" & Chr(0032) & acoord(2) & Chr(10))
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
macro attached. i just need one digit after point
RE: CREATE POINTS ON CURVE
solution: like in the old time... b=int(a*10)/10
[...]& Chr(0032) & int((acoord(0)*10)/10 & Chr(0009) & "Y" [...]
This will not force the 0 digit if any.
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
dim formatednumber(2)
for u=0 to 2
formatednumber(u) = int (acoord(u)*10)/10
if int(acoord(u)*10)/10 - int(acoord(u))=0 then
formatednumber(u) =int (acoord(u)) & ".0"
end if
next
ostream.Write ("PENDOWN" & Chr(10))
ostream.Write ("GOTO X" & Chr(0032) & formatednumber(0) & Chr(0009) & "Y" & Chr(0032) & formatednumber(1) & Chr(0009) & "Z" & Chr(0032) & formatednumber(2) & Chr(10))
ostream.Write ("PENUP"& Chr(10))
Next
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
CODE --> CATScript
Sub CATMain() 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 you want to select Dim EnableSelectionFor(0) EnableSelectionFor(0) = "HybridBody" ' Reset the Selection Set sSEL = CATIA.ActiveDocument.Selection sSEL.Clear ' Define Selection MsgBox "Please Select the Geometrical Set where you have the points" UserSelection = sSEL.SelectElement2(EnableSelectionFor, "Please select another Geometrical Set", False) ' Evaluation if the selection is correct or not If UserSelection <> "Normal" Then MsgBox "Error with the selection" Exit Sub Else Set ohybridbody = sSEL.Item(1).Value End If Set partDocument1 = CATIA.ActiveDocument Dim selection1 As Selection Set selection1 = partDocument1.Selection selection1.Search "CATPrtSearch.Point,sel" REM Set visPropertySet1 = selection1.visProperties REM VisPropertySet1.SetShow 1 ''''''''''''''''''''''''''''''' Dim part1 As Parts Set part1 = partDocument1.Part Dim selection As Selection Set selection = Catia.ActiveDocument.Selection Dim hybridShapeFactory1 As HybridShapeFactory Set hybridShapeFactory1 = part1.HybridShapeFactory Dim Obj As VispProperties Set Obj = Selection.VisProperties Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties visProperties1.SetLayer catVisLayerNone, None REM selection1.Clear Part1.Update Dim specsAndGeomWindow1 As Window Set specsAndGeomWindow1 = CATIA.ActiveWindow Dim viewer3D1 As Viewer Set viewer3D1 = specsAndGeomWindow1.ActiveViewer Dim viewpoint3D1 As Viewpoint3D Set viewpoint3D1 = viewer3D1.Viewpoint3D viewer3D1.Reframe Set viewpoint3D1 = viewer3D1.Viewpoint3D Set body1 = Bodies1.Item("PartBody") Part1.InWorkObject = Body1 'run another catscript Dim EmptyPar() Dim ScPath ScPath = "C:\temp\" CATIA.SystemService.ExecuteScript scpath, catScriptLibraryTypeDirectory, "LineNormalToSurface.CATScript", "CATMain", EmptyPar End SubThis code is not mine. I found thanks to ferdo.
greetings.
Urim
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
CATIA.StartCommand "Points And planes Repetition"
But this will only launch the command, the user will need to fill out the form and hit ok. Also, I am not sure how you could select multiple curves and run Points and planes repetition and have the macro "wait" for you to ok the points and planes repetition window...there may be a way though.
You may be able to have a macro that behaves differently based on what the user selects. If they pick a curve, it launches points and planes repetition...if they pick a part, it writes out the text file. If you have 10s or 100s of curves to select...this would not be a good option.
The more difficult (but maybe more efficient if you have a lot of curves) approach would be to create the points manually in your macro (don't use points and planes repetition)
The user selects several curves then inputs the number of points they want on the curves
The macro calculates: Ratio = 1/(# of instances - 1) then loops to create the points
For i=1 to oSelection.Count 'many curves are selected
You also mentioned looping through geosets...do the curves already exist in the geosets? Are the points supposed to go in the same geoset as the curve?
It is difficult to help without knowing exactly what you need to do.
RE: CREATE POINTS ON CURVE
why do i need that? laser projection for composite parts.
so i have several closed contours located in the same geometrical set.
macro have to disassemble contour, create points with specified distance including end points. created points for each contour must be in a separate geo set. at this step i'm not talking about export to txt all that points. this will be next step.
i have an exe program but it works slow especially on big parts.
i guess the reason it works slow is ratio. in exe i have points also created using ratio and not points and planes repetition.
seems like points and planes repetition works faster.
see how looks spec tree
RE: CREATE POINTS ON CURVE
guys really need help on that.
thanks in advance.
CODE --> catscript
'Language = "VBSCRIPT"
Sub CATMain()
Dim filename As String
filename = CATIA.ActiveDocument.Name
Dim path As String
path = CATIA.ActiveDocument.path
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) = "HybridBody"
' Reset the Selection
Set sSel = CATIA.ActiveDocument.Selection
sSel.Clear
' Define Selection
MsgBox "Please Select the Geometrical Set where are the points for extracting"
UserSelection = sSel.SelectElement3(EnableSelectionFor, "Please select another Geometrical Set", False, CATMultiSelTriggWhenUserValidatesSelection, True)
' Evaluation if the selectio is correct or not
If UserSelection <> "Normal" Then
MsgBox "Error with the selection"
Exit Sub
Else
Set ohybridbody = sSel.Item(1).Value
MsgBox "The Geometrical Set selected is : " & ohybridbody.Name
End If
ReDim 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)
Set Datos = CATIA.FileSystem.CreateFile(path & "\" & CATIA.ActiveDocument.Name & ".txt", True)
Set ostream = Datos.OpenAsTextStream("ForAppending")
ostream.Write (oPartDoc.Name & Chr(10))
ostream.Write (" " & Chr(10))
'ostream.Write ("The selected Geometrical Set was : " & ohybridbody.Name & Chr(10))
ostream.Write (" " & Chr(10))
ostream.Write ("$* PLY" & Chr(32) & ohybridbody.Name & Chr(10))
ostream.Write ("PENDOWN" & Chr(10))
Set oshapes = ohybridbody.HybridShapes
For i = 1 To oshapes.Count
oshapes.Item(i).GetCoordinates acoord
Set reference1 = oshapes.Item(i)
Dim formatednumber(2)
For U = 0 To 2
formatednumber(U) = Int(acoord(U) * 10) / 10
If Int(acoord(U) * 10) / 10 - Int(acoord(U)) = 0 Then
formatednumber(U) = Int(acoord(U)) & ".0"
End If
Next
'ostream.Write ("PENDOWN" & Chr(10))
ostream.Write ("GOTO " & Chr(32) & formatednumber(0) & Chr(32) & "" & Chr(32) & formatednumber(1) & Chr(32) & "" & Chr(32) & formatednumber(2) & Chr(10))
'ostream.Write ("PENUP" & Chr(10))
'ostream.Write ("GOTO " & Chr(32) & formatednumber(0) & Chr(32) & "" & Chr(32) & formatednumber(1) & Chr(32) & "" & Chr(32) & formatednumber(2) & Chr(10))
Next
ostream.Write ("PENUP" & Chr(10))
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 Sub
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
just need i hint how to do that.
RE: CREATE POINTS ON CURVE
Set ohybridbody = sSel.Item(1).Value
you could replace that by
Set ohybridbody = sSel.Item(u).Value
and include all required lines into a for u = 1 to sSel.count // next loop
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
Let me get back to you on the points by ratio. Regarding looping through multiple geosets, you just need to move some things around and add an extra loop
-Loop through geosets
--Loop through points
See below...I did not test this so hopefully it works or you can let us know what line it fails at...I just modified the code you posted above, started at "define selection"
CODE --> CATScript/catvbs
' 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 Dim aGeosets(sSel.Count-1) 'Loop through geosets and store in array For i = 1 to sSel.Count 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) Set Datos = CATIA.FileSystem.CreateFile(path & "\" & CATIA.ActiveDocument.Name & ".txt", True Set ostream = Datos.OpenAsTextStream("ForAppending") 'Header ostream.Write (oPartDoc.Name & Chr(10)) ostream.Write (" " & Chr(10)) 'Blank line 'ostream.Write ("The selected Geometrical Set was : " & ohybridbody.Name & Chr(10)) ostream.Write (" " & Chr(10))' Blank line '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.Write ("$* PLY" & Chr(32) & ohybridbody.Name & Chr(10)) 'First line in your picture ostream.Write ("PENUP" & Chr(10)) ' 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.Write ("GOTO " & Chr(32) & formatednumber(0) & Chr(32) & "" & Chr(32) & formatednumber(1) & Chr(32) & "" & Chr(32) & formatednumber(2) & Chr(10)) If j = 1 then ostream.Write ("PENDOWN" & Chr(10))'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.Write ("PENUP" & Chr(10)) '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 SubRE: CREATE POINTS ON CURVE
So you have a geoset with curves in it and you want to create points on each curve with end points
For this you can use points by ratio: 0 is the start, 1 is the end and the number of points you want on each curve is calculated by looping from 0 to n and multiplying by [1/(n-1)] each time. I would add the points to a new geoset so when you loop to make your text file, you don't have to worry about skipping the curves if they are in the same geoset (a hybridshape can be a point, curve, plane, etc).
I tried to use variables you already had in your code, assuming this would be part of it.
CODE --> CATScript
'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 '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) '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) 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 next Next Next sSel.clear 'Clear the selectionHope this works and it helps you.
RE: CREATE POINTS ON CURVE
in the points export macro i get an error at line
Dim aGeosets(sSel.Count-1)
in the points creation macro window pops p several times and no matter what value i'm entering nothing happens.
it says me "You did not enter an integer" but yes i did. how to deal with that?
i wish to enter value once for all geo sets.
RE: CREATE POINTS ON CURVE
I need to know what the error is at
CODE --> CATScript
It should simply make an array with sSel.Count-1 elements. Let me know.
For the point creation code, I am not sure why it would not accept your input...Unless some of the functions are not available in CATScript. I did test the "check for integer" part in VBA and it worked good, lets just remove that stuff for now and see if we can get it to work.
CODE --> CATScript
'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 'LoopRE: CREATE POINTS ON CURVE
arraySize= 20
Dim myArray() : ReDim myArray(arraySize)
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
about points creation macro. i did a change in geo set creation. changed it to Set oPointGeoset = oPart.hybridBodies.add()
and changed oGSD to oHSF
works well but macro creates geo set for each curve. i need all the point in one geo set.
i also changed lRatio = 1 / (CInt(sResponse)). if you use lRatio = 1 / (CInt(sResponse) -1) macro creates points outside a curve if you enter to much points in dialog box
RE: CREATE POINTS ON CURVE
almost done. combined disassembling macro and points creation macro and now stuck with points export.
ferdo thanks a lot for disassembing macro from this thread.
http://www.eng-tips.com/viewthread.cfm?qid=394777
can someone help me with my last question on that thread? i asked about putting curves in different geo sets
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
sorry for the questions. just starting to get into VBA.
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
If I take the code above and put it in VBA I can not run the script.
Provide sample of code ready to be copy/paste.
I had to add stuff like this to be able to pass the first few line
CODE --> VBA
If I replace your Dim line with the ReDim I have a error message on another line. So the problem is not with ReDim no more.
when you work on a script if for any GOOD reason you use on error resume next, you should also use on error goto 0 in order to localize the effect of 'resume next', so you can actually catch error when they arrive.
I let you post the solution...
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
CODE --> vba
Sub CATMain() Dim filename As String filename = CATIA.ActiveDocument.Name Dim path As String path = CATIA.ActiveDocument.path 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 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) Set Datos = CATIA.FileSystem.CreateFile(path & "\" & CATIA.ActiveDocument.Name & ".txt", True) Set ostream = Datos.OpenAsTextStream("ForAppending") 'Header ostream.Write (oPartDoc.Name & Chr(10)) ostream.Write (" " & Chr(10)) 'Blank line 'ostream.Write ("The selected Geometrical Set was : " & ohybridbody.Name & Chr(10)) ostream.Write (" " & Chr(10)) ' Blank line '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.Write ("$* PLY" & Chr(32) & ohybridbody.Name & Chr(10)) 'First line in your picture ostream.Write ("PENUP" & Chr(10)) ' 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.Write ("GOTO " & Chr(32) & formatednumber(0) & Chr(32) & "" & Chr(32) & formatednumber(1) & Chr(32) & "" & Chr(32) & formatednumber(2) & Chr(10)) If j = 1 Then ostream.Write ("PENDOWN" & Chr(10)) '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.Write ("PENUP" & Chr(10)) '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 Subthe picture mentioned in this macro posted above
RE: CREATE POINTS ON CURVE
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
will wait for lardman. he did some changes to original macro.
RE: CREATE POINTS ON CURVE
remove the on error resume next at the beginning of the script...
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
object doesn't support this property or method
aGeosets(i - 1) = sSel.Item(i).Value
RE: CREATE POINTS ON CURVE
so what is the solution?
who do you define object in vba?
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
RE: CREATE POINTS ON CURVE
a = 20
how to define an object in VBA:
set myObject = CATIA.activedocument (or anything else)
indocti discant et ament meminisse periti
RE: CREATE POINTS ON CURVE
Dim aGeosets()
ReDim aGeosets(sSel.Count-1)
If the thing in your selection is an object you have to set the array element
Set aGeosets(i - 1) = sSel.Item(i).Value
Sorry about that.
Your path was not being set using .Path
You did not dim ohybridbody so oshapes was not getting set
The way you were writing your lines was not working
CHR(10) was not making returns
Points on curve
CODE --> VBA
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 SubExtract points
CODE --> vba
Sub 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 SubRE: CREATE POINTS ON CURVE
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ostream = oFSO.CreateTextFile(sFileLocation, True)
not working for me so changed it back to datos. WriteLine also not working changed it back to Write. now the script running ok.
about points creation macro. i did a change in geo set creation. changed it to Set oPointGeoset = oPart.hybridBodies.add()
and changed oGSD to oHSF
works well but macro creates geo set for each curve. i need all the point in one geo set.
i also changed lRatio = 1 / (CInt(sResponse)). if you use lRatio = 1 / (CInt(sResponse) -1) macro creates points outside a curve if you enter to much points in dialog box
later i'll combine all that together.
i really appreciate your help
cheers.
RE: CREATE POINTS ON CURVE
Funny...when I ran it with lRatio = 1 / (CInt(sResponse)) it created points off the curve.
Yes, oPartDoc should be oPart...I figured i would leave it since you already had it set up that way. But a part and a part document are different...so it would be best if your variables matched what their type is.
See below for only making one geoset...you just need to move the geoset creation out of the loop. Hopefully you can use this to start to learn how to piece things together. Do you have the V5Automation.chm file? That will help you. You can also check out w3schools for online/realtime examples of VBscript.
CODE --> vba
RE: CREATE POINTS ON CURVE
CODE --> vba
'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 geosetRE: CREATE POINTS ON CURVE
run attached exe to understand how that supposed to work. exe not perfect. it takes like an hour to create laser projection file for 16 contours.part dimensions is like 1x1 meter. with macros you and ferdo did it's much more faster.
the way to speed up macro is skipping disassembling and use point repetition instead of ratio. the problem is there are no end points if i run points repetition command. laser reads coordinates using command goto and creates projection of a contour. without end points this will not be a perfect projection. is there a way to create point repetition on a closed curve with end point option on? i see no options.
how to use exe:
create 6 points no matter where, select them, select contours and hit create results.
RE: CREATE POINTS ON CURVE
If you run points and planes repetition manually, I thought there was an option for end points...but not on a closed curve...it won't know where the corners are.
RE: CREATE POINTS ON CURVE
i need to loop following
CODE --> vba
definitely i should not to use hybridBody2
attached combined macro. this will let to select curve, create points and export them
RE: CREATE POINTS ON CURVE
The code you posted it in a loop? If you only want one geoset, Take the first 2 lines of code out of the loop and remove I from the name in the second line. That should put all the selected curves into the same geoset.
RE: CREATE POINTS ON CURVE
i'll try to move the lines and will let you know how it's going.
actually i'm coming from CAM software(Cimatron and Nx) and from post-processors development but it's different from VBA. that is why i got so many questions. for the past few years only Catia primary composites and tooling design for composites and sheet metal.
cheers and have a good weekend.
don's worry about exe. i work with it everyday. if system blocks it just rename txt to exe.
http://files.engineering.com/getfile.aspx?folder=8...
RE: CREATE POINTS ON CURVE