Cancel
Showing results for 
Search instead for 
Did you mean: 

FEMAP API offset a line/o parallel line

Gears Phenom Gears Phenom
Gears Phenom

Hello, 

 

I am trying to do though API a line offset but i did not find in the help anyting. Only parallel line (feLineParallel)

. But in this case the line is created in the working plane. And here I found the next problem. How to align the wp to a plane. I tried to use fePlaneCSys or similar options but It did not work

3 REPLIES 3

Re: FEMAP API offset a line/o parallel line

Siemens Phenom Siemens Phenom
Siemens Phenom

How about making a copy along some vector?  The script below uses a vector pick but you could exclude that step and use whatever offset parameters you need.

 

Curve_Copy.gif

 

Sub Main
    Dim App As femap.model
    Set App = feFemap()

    Dim c As Curve
    Dim p As Point

    Set c = App.feCurve
    Set p = App.fePoint

Again:
    If c.SelectID("Select Curve for Offset...") <> FE_OK Then End

    Dim vecLength As Double
    Dim vecBase As Variant
    Dim vecDir As Variant

    If App.feVectorPick("Copy Along...", False, vecLength, vecBase, vecDir ) <> FE_OK Then
        GoTo Again
    End If

    rc = App.feGenerateCopy(FT_CURVE, -c.ID, vecDir, nodeINC, False )

End Sub

Re: FEMAP API offset a line/o parallel line

Gears Phenom Gears Phenom
Gears Phenom

Hello,

 

I wrote an API to create offset to curves (lines, arcs and circles), but it's not finished yet (I want to use it to splines and solid curves too and auto select workplane). To using API you need to select workplane first, then select curves.

It use the attached ini file (location in macro is D:\KadP_Femap.ini) to save offset value (you can use expression too). If you wouldn't like to use ini file, you can change the macro. To using ini file you have to add Windows Script Host Object Model to reference:

 

Reference.jpg

 

 

'Offset Curves (Line, Circle or Arc) by Peter Kaderasz
Dim App As femap.model
Dim sOffset As String
Dim bIni_Found As Boolean
Dim iniFileName_KadP As String

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpAppName As String, _
	ByVal lpKeyName As String, _
	ByVal lpDefault As String, _
	ByVal lpReturnedString As String, _
	ByVal nSize As Long, _
	ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
	(ByVal lpApplicationName As String, _
	ByVal lpKeyName As String, _
	ByVal lpString As String, _
	ByVal lpFileName As String) As Long

Private fs As IWshRuntimeLibrary.FileSystemObject

Sub Main
	Set App = feFemap()
	Dim curveSet As femap.Set
	Set curveSet = App.feSet
	Dim curveID As Long
	Dim feCurve As femap.Curve
	Set feCurve = App.feCurve
	Dim fePoint As femap.Point
	Dim fePt2 As femap.Point
	Set fePoint =App.fePoint
	Set fePt2 =App.fePoint
	Dim pt1_ID As Long, pt2_ID As Long
	Dim side_xyz As Variant, side_wp_xyz As Variant
	Dim nSide As Long
	Dim mid_xyz As Variant, midloc_new As Variant
	Dim center As Variant, norm As Variant, startloc As Variant, endloc As Variant
	Dim startloc_new As Variant, endloc_new As Variant
	Dim angle As Double, radius As Double
	Dim side_angle_start As Double, side_angle_end As Double
	Dim dist_center As Double

	Dim nOffset As Double

	InitializeVariables

	sOffset = InputBox("Offset: ", "Offset Curve", sOffset)
	If sOffset="" Then
		Exit Sub
	End If

	rc=App.feVarEval(sOffset, nOffset)
	If rc=FE_BAD_DATA Then
		App.feAppMessage( FCM_ERROR  , "Equation cannot be evaluated - Cancelled")
		Exit Sub
	End If

	If nOffset=0 Then
		App.feAppMessage( FCM_ERROR  , "Offset is Null - Cancelled")
		Exit Sub
	End If

	App.feAppMessage( FCM_COMMAND  , "Offset Curve (Line, Circle or Arc) by " & nOffset)

	ReDim startloc_new(2)
	ReDim endloc_new(2)
	ReDim midloc_new(2)

CIKLUS:

	rc = curveSet.Select( FT_CURVE, True , "Select Curves for Offset (Cancel to exit)" )

	If rc = FE_CANCEL Then
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	If rc=FE_NOT_EXIST Or curveSet.Count=0 Then
		App.feAppMessage( FCM_ERROR, "Curves not selected - Cancelled")
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	rc=App.feCoordPick("Locate - Enter Any Location on Side of Offset Curve", side_xyz)

	If rc = FE_CANCEL Then
		App.feViewRegenerate( 0 )
		Exit Sub
	End If

	curveID=curveSet.First()
	While curveID>0
		rc=feCurve.Get(curveID)
		If feCurve.IsStraight Then
			rc=App.feLineParallel(nOffset, curveID, side_xyz, True)
			If rc=FE_FAIL Then
				MsgBox("Could not create the offset Line")
			End If
		ElseIf feCurve.IsArc Then 'Arc Curve
			nSide=1
			rc=App.feCoordCurveMidpoint(curveID, mid_xyz)
			rc=feCurve.ArcCircleInfo(center, norm, startloc, endloc, angle, radius)
			rc=App.feCoordOntoPlane(side_xyz, norm, center, norm, side_wp_xyz)
			If feCurve.type=FCU_CIRCLE Then
				rc=App.feMeasureDistance(side_wp_xyz, center, dist_center)
				If Abs(dist_center-radius)<1E-4 Then
					nSide=0
				ElseIf dist_center<radius Then
					nSide=-1
				End If
			Else	'FCU_ARC
				rc=App.feMeasureAngle(startloc, center, side_wp_xyz, side_angle_start)
				rc=App.feMeasureAngle(endloc, center, side_wp_xyz, side_angle_end)
				If Abs(side_angle_start-90)<1E-4 Or Abs(side_angle_end-90)<1E-4 Then
					nSide=0
				ElseIf side_angle_start<90.0 And side_angle_end<90.0 Then
					nSide=-1
				End If
			End If
			If nSide<>0 Then
				startloc_new(0)=startloc(0)+nSide*(startloc(0)-center(0))/radius*nOffset
				startloc_new(1)=startloc(1)+nSide*(startloc(1)-center(1))/radius*nOffset
				startloc_new(2)=startloc(2)+nSide*(startloc(2)-center(2))/radius*nOffset
				endloc_new(0)=endloc(0)+nSide*(endloc(0)-center(0))/radius*nOffset
				endloc_new(1)=endloc(1)+nSide*(endloc(1)-center(1))/radius*nOffset
				endloc_new(2)=endloc(2)+nSide*(endloc(2)-center(2))/radius*nOffset
				midloc_new(0)=mid_xyz(0)+nSide*(mid_xyz(0)-center(0))/radius*nOffset
				midloc_new(1)=mid_xyz(1)+nSide*(mid_xyz(1)-center(1))/radius*nOffset
				midloc_new(2)=mid_xyz(2)+nSide*(mid_xyz(2)-center(2))/radius*nOffset
				If feCurve.type=FCU_CIRCLE Then
					rc=App.feCircleRadius(center, startloc_new, True)
				Else	'FCU_ARC
					rc=App.feArcPoints(startloc_new, midloc_new, endloc_new, True)
				End If
			Else
				App.feAppMessage( FCM_NORMAL, "Point lies on Curve " & curveID)
			End If

		ElseIf feCurve.type=FCU_SOLID Then
			MsgBox ("Solid Curve")
		End If

		curveID=curveSet.Next
	Wend
	App.feViewRegenerate( 0 )

	If bIni_Found Then
		x = WritePrivateProfileString("PARAMETERS", "Offset", sOffset, iniFileName_KadP)
	End If

End Sub

Sub InitializeVariables
	iniFileName_KadP = "d:\KadP_Femap.ini"

	Set fs = New IWshRuntimeLibrary.FileSystemObject

	If Not fs.FileExists(iniFileName_KadP) Then
		MsgBox("File KadP.ini not found in following location" & vbCrLf & vbCrLf _
			& iniFileName_KadP)
		bIni_Found=False
		Exit Sub
	End If

	bIni_Found=True
	sOffset = ReadINIfile("PARAMETERS", "Offset", iniFileName_KadP)
	If sOffset="" Then sOffset="0"
	On Error GoTo 0

End Sub

Function ReadINIfile(sSection As String, sEntry As String, sFileName As String) As String
	Dim x As Long
	Dim sDefault As String
	Dim sRetBuf As String, iLenBuf As Integer
	Dim sValue As String
	sDefault$ = ""
	sRetBuf$ = String$(256, 0)
	iLenBuf% = Len(sRetBuf$)
	x = GetPrivateProfileString(sSection, sEntry, sDefault$, sRetBuf$, iLenBuf%, sFileName)
	ReadINIfile = Left$(sRetBuf$, x)
End Function

 

Best regards

 

Peter Kaderasz

Re: FEMAP API offset a line/o parallel line

Gears Phenom Gears Phenom
Gears Phenom

Thanks mates. I got  to solve it doing it in another way.

 

But I think it should be added something to align the workingplane through API. Maybe there is and I did not find it.