Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

Register Log in
  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

CREATE POINTS ON CURVE 1

Status
Not open for further replies.
JeniaL

JeniaL

Mechanical
Jun 3, 2014
547
IL
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.
 
Replies continue below

Recommended for you

Sort by date Sort by votes
lardman could you please be more specific on points creation by ratio? let's say i'm selecting several curves and then adding them to collection. now how to apply point by ratio command to my selection in VBA. as you mentioned before ratio = 1/to number of instances. can i read number of instances from file or from dialog box?
 
Upvote 0 Downvote
JeniaL,
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: 
' 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 Sub
 
Upvote 0 Downvote
For points on a 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: 
'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 selection

Hope this works and it helps you.
 
Upvote 0 Downvote
thanks o lot for your help.

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.
 
Upvote 0 Downvote
No problem:) I started writing macros with no experience and no training available. There were a few people who helped me along the way, so I am returning their favor:)

I need to know what the error is at

Code: 
Dim aGeosets(sSel.Count-1)

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: 
'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
 
Upvote 0 Downvote
you don't Dim with a variable size, you ReDim

arraySize= 20
Dim myArray() : ReDim myArray(arraySize)

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
Dim aGeosets(sSel.Count-1) . in vba i have following error "constant expression required"

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

 
Upvote 0 Downvote
so can anyone help me with Dim aGeosets(sSel.Count-1) error?
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.

can someone help me with my last question on that thread? i asked about putting curves in different geo sets
 
Upvote 0 Downvote
did you miss my post?

me said:
you don't Dim with a variable size, you ReDim

arraySize= 20
Dim myArray() : ReDim myArray(arraySize)
Click to expand...

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
thanks. missed that. what do i need to replace? if i just replace dim with redim thet txt file is empty.
sorry for the questions. just starting to get into VBA.
 
Upvote 0 Downvote
well if i had to guess I would replace the Dim aGeosets(sSel.Count-1) line

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
if i just replace dim with redim then txt file is empty. edited my post after you answered
 
Upvote 0 Downvote
you code is still buggy here and there, please use VBA tools (F8) and Locals window to see what is going on.

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: 
Set sSel = CATIA.ActiveDocument.Selection
Dim EnableSelectionFor(0)
EnableSelectionFor(0) = "HybridBody"
path = "c:\temp"

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...

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
here's complete code. replaced dim with redim but there are no coordinates in txt file.
Code: 
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 Sub

the picture mentioned in this macro posted above
 
Upvote 0 Downvote
any error message? what line?

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
no errors. that is what i changed ReDim aGeosets(sSel.Count - 1).
will wait for lardman. he did some changes to original macro.
 
Upvote 0 Downvote
me said:
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.
Click to expand...

remove the on error resume next at the beginning of the script...

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
got it.
object doesn't support this property or method
aGeosets(i - 1) = sSel.Item(i).Value
 
Upvote 0 Downvote
good

so what is the solution?

who do you define object in vba?

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
can't find out how to deal with that. i'm not a pro in VBA.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

NaWin55
  • Locked
  • Question
Catia create points using Excel data
Replies
5
Views
144
TudorM
TudorM
W
  • Question
How to Define Circle Edges for Points in CATIA VBA?
Replies
3
Views
833
TudorM
TudorM
JHCMMAN
  • Locked
  • Question
Cannot create Front View in Drafting
Replies
0
Views
64
JHCMMAN
JHCMMAN
DSESDJ
  • Locked
  • Question
[CATIAV5] LF VBA Macro to generate normal axis systems on projected points.
Replies
9
Views
84
itsmyjob
itsmyjob
Skyhawk739
  • Locked
  • Question
sending points to a function selection window
Replies
2
Views
76
Skyhawk739
Skyhawk739

Part and Inventory Search

Sponsor

Back
Top