版主给我开通进入cad博客的权限吧,我贡献一个修改数字的程序

mycad

'此程序在cad2002上测试通过,cad2006上须改动" If Val(TXTSTR) <> 0 And WS = "2" Then" 为"If Val(TXTSTR) = 0  "

2. Public Sub modify_GC()
3.   Dim SSETS As AcadSelectionSet
4.   'Dim Element As Object
5.   'Dim ENTITY As AcadEntity
6.    Dim entity As AcadEntity ';定义为Object或ACADObject或AcadEntity都可以，但有区别！
7.    Dim GCTET As String
8.    Dim gcdlayer As AcadLayer
9.    Dim gzz As Double
10.    'Dim WS As String '小数点位数
11.   'Set gcdlayer = ThisDrawing.Layers.Item("Gcd")
12.   'MsgBox "jtgjj"
14. On Error Resume Next
15. ' WS = InputBox("请输入小数点位数，默认为2位：", , "2")
16. gzz = InputBox("*****请输入改正值,默认为0：*****", , "0")
17.   If Not IsNull(ThisDrawing.SelectionSets.Item("GCDSET")) Then
18.      Set SSETS = ThisDrawing.SelectionSets.Item("GCDSET")
19.      SSETS.Delete
20.   End If
21.   Set SSETS = ThisDrawing.SelectionSets.Add("GCDSET")
22.   
23.    'Set ssets = ThisDrawing.SelectionSets.Add("SSET")
24.     SSETS.Select acSelectionSetAll
25.    
26.   
27.    For Each entity In SSETS
28.     'If ENTITY.ObjectName = "AcDbText" Then
29.       TXTSTR = entity.TextString
30.       If Val(TXTSTR) <> 0 And WS = "2" Then
31.         entity.TextString = Format((Val(TXTSTR) + Val(gzz)), "0.00")
32.         Else: entity.TextString = Format((Val(TXTSTR) + Val(gzz)), "0.0")
33.           If entity.ObjectName = "AcDbText" Then
34.           entity.color = acGreen + acRed
35.           entity.Update
36.           End If
37.       End If
38.      
39.      'MsgBox entity.ObjectName
40.       'entity.Highlight
41.      ' MsgBox ENTITY '
42.       'currentspace = ThisDrawing.ActiveSpace
43.    
44.      'GCTEXT = Element.TextString
45.    'If Val(ENTITY) <> 0 Then
46.     'ENTITY = Format(ENTITY, "0.0")
47.    'ENTITY.Update
48.   
49.    '
50. ' End If
51.    Next
52.    MsgBox "数据修改完毕！"
53.    Exit Sub
54.    MsgBox "出问题啦！"
55.    
56. End Sub

Public Sub modify_GC()   Dim SSETS As AcadSelectionSet   'Dim Element As Object   'Dim ENTITY As AcadEntity    Dim entity As AcadEntity ';定义为Object或ACADObject或AcadEntity都可以，但有区别！    Dim GCTET As String    Dim gcdlayer As AcadLayer    Dim gzz As Double    'Dim WS As String '小数点位数   'Set gcdlayer = ThisDrawing.Layers.Item("Gcd")   'MsgBox "jtgjj" On Error Resume Next ' WS = InputBox("请输入小数点位数，默认为2位：", , "2") gzz = InputBox("*****请输入改正值,默认为0：*****", , "0")   If Not IsNull(ThisDrawing.SelectionSets.Item("GCDSET")) Then      Set SSETS = ThisDrawing.SelectionSets.Item("GCDSET")      SSETS.Delete   End If   Set SSETS = ThisDrawing.SelectionSets.Add("GCDSET")       'Set ssets = ThisDrawing.SelectionSets.Add("SSET")     SSETS.Select acSelectionSetAll           For Each entity In SSETS     'If ENTITY.ObjectName = "AcDbText" Then       TXTSTR = entity.TextString       If Val(TXTSTR) <> 0 And WS = "2" Then         entity.TextString = Format((Val(TXTSTR) + Val(gzz)), "0.00")         Else: entity.TextString = Format((Val(TXTSTR) + Val(gzz)), "0.0")           If entity.ObjectName = "AcDbText" Then           entity.color = acGreen + acRed           entity.Update           End If       End If            'MsgBox entity.ObjectName       'entity.Highlight      ' MsgBox ENTITY '       'currentspace = ThisDrawing.ActiveSpace          'GCTEXT = Element.TextString    'If Val(ENTITY) <> 0 Then     'ENTITY = Format(ENTITY, "0.0")    'ENTITY.Update       ' ' End If    Next    MsgBox "数据修改完毕！"    Exit Sub    MsgBox "出问题啦！"     End Sub

mccad

过段时间升级了服务器再说吧，目前网站空间不够用，暂时不考虑申请。

程序应考虑更大的给用户的灵活性,而你的程序只给用户保留小数后一位或两位的功能，不能再有其它，明显还不够灵活。希望再改进。

mycad

要想改变小数点位数只要把下面的" ' "删掉即可,用户可以在InputBox中输入要保留的小数位数

' WS = InputBox("请输入小数点位数，默认为2位：", , "2")