§Sub CreateSurfaceSymbol()
§ Dim acmApp As AcadmApplication
§ Set acmApp =
ThisDrawing.Application.GetInterfaceObject("AcadmAuto.AcadmApplication")
§
§ Dim acmUtil As McadUtility
§ Set acmUtil =
acmApp.ActiveDocument.Utility
§
§ Dim varPt As Variant
§ varPt =
acUtil.GetPoint(, "Start point for SurfaceSymbol: ")
§ varPt = acUtil.TranslateCoordinates(varPt,
acUCS, acWorld, False)
§
§ Dim acmSurfTexture As McadSurfaceTexture
§ Set acmSurfTexture
= ThisDrawing.ModelSpace.AddCustomObject("AcmSurfaceTexture")
§
§ ' Define
points for leader
§ Dim aPoints(0 To
8) As Double
§ Dim aPt1(0 To 2)
As Double
§ Dim aPt2(0 To 2)
As Double
§
§ aPt1(0) =
varPt(0) + 2: aPt1(1) = varPt(1) + 2: aPt1(2) = 0
§ aPt2(0) = varPt(0) + 3: aPt2(1) = aPt1(1):
aPt2(2) = 0
§
§ aPoints(0) = varPt(0): aPoints(1) =
varPt(1): aPoints(2) = 0 'start point
§ aPoints(3) = aPt1(0): aPoints(4) =
aPt1(1): aPoints(5) = 0 'second point
§ aPoints(6) = aPt2(0): aPoints(7) =
aPt2(1): aPoints(8) = 0 'third point
§
§ acmSurfTexture.AddLeader (aPoints)
§
§ acmSurfTexture.AllowanceValue =
"EE"
§ acmSurfTexture.ProductionValue =
"BBB"
§ acmSurfTexture.RaMaximumValue =
"AAA"
§ acmSurfTexture.RaMinimumValue =
"AAAAAA"
§ acmSurfTexture.SamplingLengthValue =
"CCCC"
§
§ Dim acmPick As McadPick
§ Set acmPick =
acmUtil.Pick("Pick a line", mcLine)
§
§ Dim acmLine As McadLine
§ Set acmLine =
acmUtil.GetObjectFromPick(acmPick)
§
§ acmSurfTexture.AttachGeometry oLine,
varPt
§ acmSurfTexture.UpdateToAttachedObject
§
§ ThisDrawing.Application.Update
§End
Sub