‹#›
© 2008 Autodesk
ADSK_BLack_BAR.png
ADN Webcasts 2008
§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
SymBBAuto