社区 › VB › 请教:关于更改标注的全局比例

wdxbf 发表于 2004-5-22 20:49:00

请教:关于更改标注的全局比例

我在用vba 绘图时,标注过程中,所有的标注相对于图纸大了些, 我想更改标注的 全局比例,可不知道怎么改, 他的属性是那个?
         我试着创建标注样式,可如何改他的这些属性呢,而且怎么才能将它作用于全部比例?

petty 发表于 2004-5-23 09:43:00

dimscale值改为多少即全局比例为多少

wdxbf 发表于 2004-5-26 09:19:00

我是初学,还是不太会,请问dimscale 是系统变量吗?          是先创建标注样式然后修改,还是直接对thisdrawing.SetVariable进行设置,
      能写一下具体代码吗?         谢谢

yicol 发表于 2004-5-26 16:50:00

这是一个调整全局比例的源码，看看改改
                       Sub scale_print()
                       Dim scalefactor As Double
                       Dim scaletype As Integer
                       scaletype = acZoomScaledRelativePSpace
                       
                       Dim ssetObj As AcadSelectionSet
                       Dim aa As AcadObject
                       Dim text As Integer
                       Dim m1 As String
                       Dim l1 As String
                       Dim starttext As String
                       Dim dimstyless As AcadDimStyle
                       Dim styless As Boolean
                       Dim dim_s As Boolean
On Error GoTo ass:
For i = 0 To ThisDrawing.SelectionSets.count - 1
                       'If thisdrawing.SelectionSets.Item(i).Name = "TEST_SSET" Then
                       ThisDrawing.SelectionSets.Item(i).Delete
                       'End If
Next i
Dim abc As AcadDimAligned
'abc.StyleName
                       Set ssetObj = ThisDrawing.SelectionSets.add("TEST_SSET")
                       
                       ' Add entities to a selection set by prompting user to select on the screen
                       ssetObj.SelectOnScreen
                       'If ssetObj.count = 0 Then
                       'Exit Sub
                       'End If
                       
                       text = ThisDrawing.Utility.GetInteger(vbCrLf & "输入一个比例:")
                       If text = 0 Then
                       Exit Sub
                       End If
                       
                       
For Each aa In ssetObj
'MsgBox aa.ObjectName
'MsgBox aa.scalefactor
'MsgBox aa.ScaleEntity
                       If aa.ObjectName = "AcDbRotatedDimension" Or aa.ObjectName = "AcDbAlignedDimension" Then
                       aa.scalefactor = text
                       End If
                       'If aa.ObjectName = "AcDbMText" Or aa.ObjectName = "AcDbText" Then
                       'aa.height = text / 30 * 80
                       'End If
                       
                       
Next
                       scalefactor = 1 / text
                       ZoomScaled scalefactor, scaletype
Exit Sub
ass:
If InStr(ThisDrawing.GetVariable("lastprompt"), "*取消*") Then
End
Else
Resume Next
End If
'thisdrawing.Utility.Prompt "小易提醒你，程序运行错误:" & Err.Description
End Sub

riechie 发表于 2004-5-28 11:47:00

请问怎么用sendcommand命令进行尺寸标注阿！

petty 发表于 2004-5-29 15:50:00

没必要这么麻烦：thisdrawing.SetVariable "dimscale" , 10 即可将全局比例改为10

雪山飞狐_lzh 发表于 2004-5-29 15:55:00

to yicol
For i = 0 To ThisDrawing.SelectionSets.count - 1
                       'If thisdrawing.SelectionSets.Item(i).Name = "TEST_SSET" Then
                       ThisDrawing.SelectionSets.Item(i).Delete
                       'End If
Next i
这里有误，你的程序一运行就跑到ass:
这来了，^_^

查看完整版本: 请教:关于更改标注的全局比例