×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

CREATE POINTS ON CURVE

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.

RE: CREATE POINTS ON CURVE

(OP)
how can i control number of digits after point? need to output just one digit.
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

try [...]& Format(acoord(0), "#.##")& [...]

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
can you be more specific please

RE: CREATE POINTS ON CURVE

ostream.Write ("GOTO X" & Chr(0032) & Format(acoord(0), "#.##") & Chr(0009) & "Y" & Chr(0032) & Format(acoord(1), "#.##") & Chr(0009) & "Z" & Chr(0032) & Format(acoord(2), "#.##") & Chr(10))

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

looks like CATScript does not like vba Format()...

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.

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

to force the .0 digit you need to create it:


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

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
thanks a lot. now it works. btw how can i loop geometrical set selection?..i want to select as much as i have geometrical sets with points and in the end create txt file

RE: CREATE POINTS ON CURVE

To GS points save in a txt is something like this.

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 Sub 

This code is not mine. I found thanks to ferdo.

greetings.
Urim

RE: CREATE POINTS ON CURVE

(OP)
still got no success with points creation. to record a macro doesn't work for me. i need to create points on curve with end points option on. any ideas guys?

RE: CREATE POINTS ON CURVE

It sounds like you want to use the feature "Points and planes repetition"...the only thing I found on this is
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
For i = 0 to # of instances
'Create a point at i*Ratio
Next
Next

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

(OP)
well it's more complicated.
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

(OP)
with a following macro can't figure out how to export points from several geo sets. after exporting points from first geo set i need penup command and then coordinates from second geo set and so on.
guys really need help on that.
thanks in advance.

CODE --> catscript

 
'num = 1 ' num of NumDigAfterDec
'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

do you want the next geomSet to be selected by user like the first one or maybe you have a logical naming convention that would help your script to find it?

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
i want to select several geo sets at once. thats why i use selectElement3 and then export all the selections. however each set must be started with penup pendwn commands. here's the example. with macro i posted above i can only export one geo set
just need i hint how to do that.

RE: CREATE POINTS ON CURVE

you define the geomSet with the line:

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

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
if i change 1 to u nothing happens and moreover u already used in the macro so i get an error.

RE: CREATE POINTS ON CURVE

and include all required lines into a for u = 1 to sSel.count // next loop

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
i'm definitely doing something wrong. now my txt file is empty. can you please point yo the lines i have to change. macro posted above.

RE: CREATE POINTS ON CURVE

(OP)
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?

RE: CREATE POINTS ON CURVE

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

RE: CREATE POINTS ON CURVE

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

Hope this works and it helps you.

RE: CREATE POINTS ON CURVE

(OP)
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.

RE: CREATE POINTS ON CURVE

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

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 --> 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
	'Loop 

RE: CREATE POINTS ON CURVE

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

RE: CREATE POINTS ON CURVE

(OP)
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

RE: CREATE POINTS ON CURVE

(OP)
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.
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

did you miss my post?

Quote (me)


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

RE: CREATE POINTS ON CURVE

(OP)
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.

RE: CREATE POINTS ON CURVE

well if i had to guess I would replace the Dim aGeosets(sSel.Count-1) line

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
if i just replace dim with redim then txt file is empty. edited my post after you answered

RE: CREATE POINTS ON CURVE

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

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

RE: CREATE POINTS ON CURVE

(OP)
here's complete code. replaced dim with redim but there are no coordinates in txt file.

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 Sub 

the picture mentioned in this macro posted above

RE: CREATE POINTS ON CURVE

any error message? what line?

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
no errors. that is what i changed ReDim aGeosets(sSel.Count - 1).
will wait for lardman. he did some changes to original macro.

RE: CREATE POINTS ON CURVE

Quote (me)

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.

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

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
got it.
object doesn't support this property or method
aGeosets(i - 1) = sSel.Item(i).Value

RE: CREATE POINTS ON CURVE

good

so what is the solution?

who do you define object in vba?

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

(OP)
can't find out how to deal with that. i'm not a pro in VBA.

RE: CREATE POINTS ON CURVE

how to define a variable in VBA:

a = 20

how to define an object in VBA:

set myObject = CATIA.activedocument (or anything else)

Eric N.
indocti discant et ament meminisse periti

RE: CREATE POINTS ON CURVE

Sorry, been busy.
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 Sub 

Extract 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 Sub 

RE: CREATE POINTS ON CURVE

(OP)
thank you so much for your help.
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

Interesting how FileSysetemObject is not working for you.
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

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

'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

'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 Sub 

RE: CREATE POINTS ON CURVE

I saw your deleted post. You were getting the object required error because the name of the geoset contained the curve geoset name, but the curve geoset was not set yet:( 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.

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 geoset 

RE: CREATE POINTS ON CURVE

(OP)
man i figured that out. that's why i deleted the post. so combined three macros together (disassemble create points and export) and it works nice when i select only one curve but when it's multiply selection i get a lot of geo sets.

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

I don't know what you mean by select one curve...which macro is making all the geosets?

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

(OP)
have you tested attached exe?

i need to loop following

CODE --> vba

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 
after that all the pieces of first selected curve must be in the same geo set.
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

No I have not tested it, I have lots of my own coding/work to do at work:) I do this from memory and let you test it, hopefully it will help you learn. Need to be careful what you run from the Internet...if it has viruses or changes the environment, there can be big trouble.

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

(OP)
sure i learn a lot from yours post..thanks a lot for the help. it's not so easy to find an info over the Internet.
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

(OP)
points creation and export works good except one thing. macro exports points in an order like it's located in a tree. i need to export point in cw or ccw direction in other way laser will not understand a code. with goto command followed by coordinates laser creates closed contour

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources