stephenhwang 发表于 2011-3-31 14:59:06

请问，VB如何读取cad中已经标注的尺寸

各位前辈，小弟想实现用鼠标点取某标注尺寸，然后进行修改，如何实现？请前辈赐教

shi 发表于 2011-5-14 12:11:01

'获取标注尺寸
Sub hqbz()
    Dim SSet1 As AcadSelectionSet
    Dim ct As Integer
    Dim fType(0) As Integer
    Dim fData(0) As Variant
    fType(0) = 0
    fData(0) = "DIMENSION"
    On Error Resume Next
    ThisDrawing.SelectionSets.Item("tes").Delete
   
   Set SSet = ThisDrawing.SelectionSets.Add("tes")
   
    SSet.SelectOnScreen fType, fData'建立选择集并从屏幕选取
    If SSet.Count = 0 Then
      SSet.Delete
      End
    End If
    ct = SSet.Count - 1
    ReDim bzcc(0 To ct)
   
    Dim i As Long
    For i = 0 To ct
      bzcc(i) = FixDimMeas(SSet.Item(i)) '获取标注的尺寸到数组
    Next
   
    For i = 0 To ct - 1 '对数组排降序，采用冒泡法
       For j = 0 To ct - i - 1
         If bzcc(j) < bzcc(j + 1) Then
         swapDX = bzcc(j): bzcc(j) = bzcc(j + 1): bzcc(j + 1) = swapDX '交换
         End If
       Next j
    Next i
    SSet.Delete
    Dim msg As String
   msg = "    标注尺寸 " & vbCrLf & vbCrLf '输出标注尺寸
    For n = 0 To UBound(bzcc)
      msg = msg + "   " & bzcc(n) & vbCrLf
    Next
    msg = msg & vbCrLf + "   总数:" + Str$(n)
MsgBoxmsg

stephenhwang 发表于 2011-4-22 14:16:39

没人回答啊

为什么任兵 发表于 2011-4-27 14:51:42

本帖最后由 为什么任兵 于 2011-4-27 14:57 编辑

我看到过一次，不过很高深的问题

stephenhwang 发表于 2011-6-20 10:52:20

非常感谢！还有个问题 FixDimMeas是什么函数？

shi 发表于 2011-7-14 14:19:16

'获取标注尺寸函数
Function FixDimMeas(Dimension As AcadDimension) As Long
    Dim BlockCount As Long
    Dim bz As Long
   
    BlockCount = ThisDrawing.Blocks.Count
      '遍历块中的对象，取得标注尺寸
      Dim EntityInBlock As AcadEntity
      For Each EntityInBlock In ThisDrawing.Blocks(BlockCount - 1)
            If EntityInBlock.ObjectName = "AcDbMText" Then
               Dimension.TextColor = acWhite      '标注文字颜色设定为白色
               bz = Dimension.Measurement
               FixDimMeas = bz
                Exit For
            End If
      Next
End Function

conqibo 发表于 2011-7-17 19:44:36

回复 shi 的帖子

请问如何 导入到txt文件中，且小数点后面两位有效数字啊？

jsxygshh 发表于 2012-9-12 10:26:47

shi 发表于 2011-7-14 14:19 static/image/common/back.gif
'获取标注尺寸函数
Function FixDimMeas(Dimension As AcadDimension) As Long
    Dim BlockCount As Lo ...

vb6.0，cad2008，xp系统下，调试不成功呀
请解释一下，在VBA中成功

jsxygshh 发表于 2012-9-13 13:56:24

盼楼主给予解答

CAD83 发表于 2012-9-29 15:34:51

分清VB和VBA的区别
页: [1]
查看完整版本: 请问，VB如何读取cad中已经标注的尺寸