How to create contour of a surface from draft angle of point its location is on high Gaussian curvature region i write the script like this but it did not work please help any one

@GHumera wrote:

Option Explicit

'Surfcae curvature analysis  at a point

Sub SurfaceCurvature

	Const rhObjectSurface = 8

	Dim strObject, arrPoint, arrParam, arrData, pt

	strObject = Rhino.GetObject("Select a surface", rhObjectSurface)

	If Rhino.IsSurface(strObject) Then

		arrPoint = Rhino.GetPointOnSurface(strObject, "Pick a test point")

		If IsArray(arrPoint) Then

			arrParam = Rhino.SurfaceClosestPoint(strObject, arrPoint)

			If IsArray(arrParam) Then

				arrData = Rhino.SurfaceCurvature(strObject, arrParam)

				If IsArray(arrParam) Then
					pt = Rhino.SurfaceDraftAnglePoint(strObject, arrParam)
					If IsArray(pt)Then Call Rhino.AddPoint(pt)

					If IsArray(arrData) Then

					Rhino.Print "Surface curvature evaluation at parameter (" & CStr(arrParam(0)) & ", " & CStr(arrParam(1)) & "):"

					Rhino.Print "  3-D Point: (" & Rhino.Pt2Str(arrData(0)) & ")"

					Rhino.Print "  3-D Normal: (" & Rhino.Pt2Str(arrData(1)) & ")"

					Rhino.Print "  Maximum principal curvature: " & CStr(arrData(2)) & " (" & Rhino.Pt2Str(arrData(3)) & ")"

					Rhino.Print "  Minimum principal curvature: " & CStr(arrData(4)) & " (" & Rhino.Pt2Str(arrData(5)) & ")"

					Rhino.Print "  Gaussian curvature: " & CStr(arrData(6))

						Rhino.Print "  Mean curvature: " & CStr(arrData(7))



					End If

				End If

			End If

		End If

	End If
End Sub

'Surface contouring depending on the draft angle

Sub SurfaceDraftAnglePoint(strObject, arrData)

	Dim contourDst

	contourDst = 2 * pt * Rhino.ToRadians(dblDegrees, Angle) * sqr(2 * arrData(6) * 0.1 - 0.01)

	arrContours = Rhino.SurfaceContourPoints(strObject, contourDst)

	If IsArray(arrContours) Then

		For Each arrPoints In arrContours

			Rhino.AddPointCloud arrPoints

		Next

	End If

End Sub

Posts: 1

Participants: 1

Read full topic