智慧住建新型基础测绘多测合一房地一体

【大鹏测绘】根据高程点高程值修改高程点注记

时间：2021-02-06 08:10 作者：AcadApp 阅读：1820 评论：8

Sub SetGcdLabelByHeight()'根据高程点高程值修改高程点注记
  Dim sSet As AcadSelectionSet
  Dim dType(0 To 2) As Integer, dData(0 To 2) As Variant
  Dim objBlock As AcadBlockReference, iCount As Integer
  Dim varAttributes As Variant, pnt As Variant, i As Integer
  dType(0) = 0: dData(0) = "INSERT"
  dType(1) = 2: dData(1) = "GC200"
  dType(2) = 8: dData(2) = "GCD"
  Set sSet = ThisDrawing.Application.ActiveDocument.SelectionSets.Add("GCD")
  sSet.Select acSelectionSetAll, , , dType, dData
  If sSet.Count = 0 Then
     MsgBox "图形中未发现高程点。", vbInformation, "修改高程点注记"
  Else
     For Each objBlock In sSet
         varAttributes = objBlock.GetAttributes
         varAttributes(0).TextString = objBlock.InsertionPoint(2)
         i = i + 1
         ThisDrawing.Application.ActiveDocument.Utility.Prompt vbCr & vbCr & "已完成 " & i & "/" & sSet.Count & " ..."
     Next
  End If
  sSet.Delete
End Sub

全部评论