Surfaces Example

Using Programming Languages other than VBA

Sub SurfaceProperties()
	Dim ssetObj As AcadSelectionSet
	Set ssetObj = ThisDrawing.SelectionSets.Add("SURFACES2")
	Dim mode As Integer

	ssetObj.SelectOnScreen

	Dim obj As AcadEntity
	Dim extrude As AcadExtrudedSurface
	Dim objName As String
	Dim LayerName As String
	For Each obj In ssetObj
		objName = obj.ObjectName
		If TypeOf obj Is AcadExtrudedSurface Then
			ExtrudedSurfaceProperties obj
		ElseIf TypeOf obj Is AcadRevolvedSurface Then
			RevolvedSurfaceProperties obj
		ElseIf TypeOf obj Is AcadLoftedSurface Then
			LoftedSurfaceProperties obj
		ElseIf TypeOf obj Is AcadSweptSurface Then
			SweptSurfaceProperties obj
		ElseIf TypeOf obj Is AcadPlaneSurface Then
			PlaneSurfaceProperties obj
		End If
	Next
	ssetObj.Delete
End Sub
Private Sub ExtrudedSurfaceProperties(extrude As AcadExtrudedSurface)
	GetSurfaceBoundingBox extrude
	MsgBox "SurfaceType: " & extrude.SurfaceType & vbCr & _
			"Height: " & extrude.Height & vbCr & _
			"TaperAngle: " & extrude.TaperAngle & vbCr & _
			"Direction: " & extrude.Direction & vbCr & _
			"Material: " & extrude.Material & vbCr & _
			"UIsolineDensity: " & extrude.UIsolineDensity & vbCr & _
			"VIsolineDensity: " & extrude.VIsolineDensity
	'Now change the configurable properties
	extrude.Height = extrude.Height * 1.5
	extrude.TaperAngle = extrude.TaperAngle * (3.14 / 2)
	extrude.UIsolineDensity = extrude.UIsolineDensity * 2#
	extrude.VIsolineDensity = extrude.VIsolineDensity * 0.5
	ThisDrawing.Regen acActiveViewport
	Utility.GetString 0, "Press return to continue..."
	'Now change the properties back to their original values
	extrude.Height = extrude.Height / 1.5
	extrude.TaperAngle = extrude.TaperAngle / (3.14 / 2)
	extrude.UIsolineDensity = extrude.UIsolineDensity / 2#
	extrude.VIsolineDensity = extrude.VIsolineDensity / 0.5
End Sub
Private Sub RevolvedSurfaceProperties(revolve As AcadRevolvedSurface)
	GetSurfaceBoundingBox revolve
	MsgBox "SurfaceType: " & revolve.SurfaceType & vbCr & _
			"RevolutionAngle: " & revolve.RevolutionAngle & vbCr & _
			"AxisPosition: " & revolve.AxisPosition & vbCr & _
			"AxisDirection: " & revolve.AxisDirection & vbCr & _
			"Material: " & revolve.Material & vbCr & _
			"UIsolineDensity: " & revolve.UIsolineDensity & vbCr & _
			"VIsolineDensity: " & revolve.VIsolineDensity
	'Now change the configurable properties
	revolve.RevolutionAngle = revolve.RevolutionAngle * (3.14 / 2)

	revolve.UIsolineDensity = revolve.UIsolineDensity * 2#
	revolve.VIsolineDensity = revolve.VIsolineDensity * 0.5

	ThisDrawing.Regen acActiveViewport
	Utility.GetString 0, "Press return to continue..."

	'Now change the properties back to their original values
	revolve.RevolutionAngle = revolve.RevolutionAngle / (3.14 / 2)
	revolve.UIsolineDensity = revolve.UIsolineDensity / 2#
	revolve.VIsolineDensity = revolve.VIsolineDensity / 0.5
End Sub
Private Sub LoftedSurfaceProperties(lofted As AcadLoftedSurface)
	GetSurfaceBoundingBox lofted
	MsgBox "SurfaceType: " & lofted.SurfaceType & vbCr & _
			"NumCrossSections: " & lofted.NumCrossSections & vbCr & _
			"NumGuidePaths: " & lofted.NumGuidePaths & vbCr & _
			"SurfaceNormals: " & lofted.SurfaceNormals & vbCr & _
			"StartDraftAngle: " & lofted.StartDraftAngle & vbCr & _
			"StartDraftMagnitude: " & lofted.StartDraftMagnitude & vbCr & _
			"EndDraftAngle: " & lofted.EndDraftAngle & vbCr & _
			"EndDraftMagnitude: " & lofted.EndDraftMagnitude & vbCr & _
			"Closed: " & lofted.Closed & vbCr & _
			"Material: " & lofted.Material & vbCr & _
			"UIsolineDensity: " & lofted.UIsolineDensity & vbCr & _
			"VIsolineDensity: " & lofted.VIsolineDensity
	'Now change the configurable properties
	lofted.StartDraftAngle = lofted.StartDraftAngle * (3.14 / 2)
	lofted.EndDraftAngle = lofted.EndDraftAngle * (3.14 / 4)
	lofted.UIsolineDensity = lofted.UIsolineDensity * 2#
	lofted.VIsolineDensity = lofted.VIsolineDensity * 0.5

	ThisDrawing.Regen acActiveViewport
	Utility.GetString 0, "Press return to continue..."

	'Now change the properties back to their original values
	lofted.StartDraftAngle = lofted.StartDraftAngle / (3.14 / 2)
	lofted.EndDraftAngle = lofted.EndDraftAngle / (3.14 / 4)
	lofted.UIsolineDensity = lofted.UIsolineDensity / 2#
	lofted.VIsolineDensity = lofted.VIsolineDensity / 0.5
End Sub
Private Sub SweptSurfaceProperties(swept As AcadSweptSurface)
	GetSurfaceBoundingBox swept
	MsgBox "SurfaceType: " & swept.SurfaceType & vbCr & _
			"ProfileRotation: " & swept.ProfileRotation & vbCr & _
			"Bank: " & swept.Bank & vbCr & _
			"Twist: " & swept.Twist & vbCr & _
			"scale: " & swept.scale & vbCr & _
			"Length: " & swept.Length & vbCr & _
			"Material: " & swept.Material & vbCr & _
			"UIsolineDensity: " & swept.UIsolineDensity & vbCr & _
			"VIsolineDensity: " & swept.VIsolineDensity

	swept.ProfileRotation = swept.ProfileRotation * 3.14 * 0.25
	swept.Bank = Not swept.Bank
	swept.Twist = swept.Twist * 3.14 * -0.5
	swept.UIsolineDensity = swept.UIsolineDensity * 2#
	swept.VIsolineDensity = swept.VIsolineDensity * 0.5

	ThisDrawing.Regen acActiveViewport
	Utility.GetString 0, "Press return to continue..."

	'Now change the properties back to their original values
	swept.ProfileRotation = swept.ProfileRotation / (3.14 * 0.25)
	swept.Bank = Not swept.Bank
	swept.Twist = swept.Twist / (3.14 * -0.5)
	swept.UIsolineDensity = swept.UIsolineDensity / 2#
	swept.VIsolineDensity = swept.VIsolineDensity / 0.5
End Sub
Private Sub PlaneSurfaceProperties(planar As AcadPlaneSurface)
	GetSurfaceBoundingBox planar
	MsgBox "SurfaceType: " & planar.SurfaceType & vbCr & _
			"UIsolineDensity: " & planar.UIsolineDensity & vbCr & _
			"VIsolineDensity: " & planar.VIsolineDensity

	planar.UIsolineDensity = planar.UIsolineDensity * 2#
	planar.VIsolineDensity = planar.VIsolineDensity * 0.5

	ThisDrawing.Regen acActiveViewport
	Utility.GetString 0, "Press return to continue..."

	'Now change the properties back to their original values
	planar.UIsolineDensity = planar.UIsolineDensity / 2#
	planar.VIsolineDensity = planar.VIsolineDensity / 0.5
End Sub
Private Sub GetSurfaceBoundingBox(surf As AcadSurface)
	Dim MinPoint As Variant
	Dim MaxPoint As Variant

	surf.GetBoundingBox MinPoint, MaxPoint

	' Print the min and max extents
	MsgBox "The extents of the bounding box for the surface are:" & vbCrLf _
	& "Min Point: " & MinPoint(0) & "," & MinPoint(1) & "," & MinPoint(2) _
	& vbCrLf & "Max Point: " & MaxPoint(0) & "," & MaxPoint(1) & "," & MaxPoint(2), vbInformation, "GetBoundingBox of Surface"
End Sub

 

   Comments?