dien 发表于 2016-12-19 18:32:49

本帖最后由 dien 于 2016-12-19 18:45 编辑



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

linsong 发表于 2016-12-19 23:22:14


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 发表于 2016-12-19 23:27:49

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

A-Ming 发表于 2016-12-19 23:55:43

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

no543216789 发表于 2016-12-20 12:41:20

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

浪天行 发表于 2017-6-11 14:02:11

这个好简单，哈哈，把里面功能删掉就好了啊，不知道楼主解决了没有
页: 1 [2] 3
查看完整版本: 有大神帮我把这个GMS修改一下么？