Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
On Error Resume Next
Dim entity As AcadObject
Dim i As Integer
Dim j As Integer
Dim rr As Integer
rr = Text1.Text
If acadDoc.ModelSpace.Count 0 Then
i = acadDoc.ModelSpace.Count
For j = 0 To i - 1
Set entity = acadDoc.ModelSpace.Item(j)
If entity.Layer = "DGX" Or entity.Layer = "dgx" Then
entity.Elevation = entity.Elevation + rr
entity.Update
End If
Next j
Else
MsgBox "在模型空间中没有对象存在。"
End If
MsgBox "完成"
End Sub
问题：１．反映太慢没有ＬＩＳＰ快
２．不知道处理到第几根线了
想法：请高手加上点，让处理线时有个进度条显示！
置顶卡
