有大神帮我把这个GMS修改一下么？

dien

简单弄了下，x6 64位，低版不知通用否

linsong

Sub 添加标注()

    Dim sr As ShapeRange
    Set sr = ActiveSelectionRange
    BeginOpt "添加标注"
    BeginOptimization
    Dim offset As Integer
    offset = 5 '偏移量
    Dim s As Shape
    For Each s In sr
        ActiveLayer.CreateLinearDimension 1, s.SnapPoints.Edge(1, 1#), s.SnapPoints.Edge(2, 1#), True, s.PositionX + s.SizeWidth / 2 + offset, 0 '垂直
        ActiveLayer.CreateLinearDimension 0, s.SnapPoints.Edge(2, 1#), s.SnapPoints.Edge(3, 1#), True, 0, s.PositionY - s.SizeHeight / 2 - offset '水平
    Next
    EndOpt
   
End Sub

Function BeginOpt(Name$)
    ActiveDocument.BeginCommandGroup Name
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrCenter
    ActiveDocument.SaveSettings
    ActiveDocument.PreserveSelection = False
End Function

Function BeginOptimization()
    Optimization = True
    EventsEnabled = False
End Function

Function EndOpt()
    ActiveDocument.PreserveSelection = True
    ActiveDocument.RestoreSettings
    EventsEnabled = True
    Optimization = False
    Application.Refresh
    ActiveDocument.EndCommandGroup
End Function

linsong

..........................................................

A-Ming

有些只标高和宽的！不用标完再去删了！

no543216789

GMS要改还是比较方便的，在CDR里面就可以

浪天行

这个好简单，哈哈，把里面功能删掉就好了啊，不知道楼主解决了没有