[VBA]帮忙修改一下程序

bsqm

这是我仿照VB.NET程序在VBA里编的程序，运行是出编译错误，各位大虾帮忙改改！ Dim entity As AcadEntity
--------------------------------------------------------------------------------------------------------------
Sub 读取属性()
Me.danyuanhao.Text = ""
Me.tiji.Text = ""
Me.midu.Text = ""
Me.bire.Text = ""
Me.danweifarelv = ""
Me.wendushifou = ""
Me.wenduzhi = ""

Dim varattributes As Object
varattributes = entity.GetAttributes
Dim i As Integer
For i = LBound(varattributes) To UBound(varattributes)
Select Case varattributes(i).TagString
Case "单元号"
Me.danyuanhao.Text = varattribute(i).TextString
Case "体积"
Me.tiji.Text = varattribute(i).TextString
Case "密度"
Me.midu.Text = varattribute(i).TextString
Case "比热"
Me.bire.Text = varattribute(i).TextString
Case "单位发热率"
Me.danweifarelv.Text = varattribute(i).TextString
Case "温度:已 知(0)否(1)"
Me.wendushifou.Text = varattribute(i).TextString
Case "温度值"
Me.wenduzhi.Text = varattribute(i).TextString
End Select
Next
entity.Highlight (False)
End Sub
--------------------------------------------------------------------------------------------------------------
Private Sub chaxun1_Click()
On Error Resume Next

UserForm1.Hide

Dim basePnt As Object

ThisDrawing.Utility.GetEntity entity, basePnt, "选择实体"

If Err.Number <> 0 Then
Err.Clear
MsgBox "图形不是块参照或未选中"
Exit Sub
End If
entity.Highlight (True)
Call 读取属性

UserForm1.Show

End Sub
--------------------------------------------------------------------------------------------------------------
Private Sub end1_Click()
End
End Sub
--------------------------------------------------------------------------------------------------------------
Private Sub MultiPage1_Change() End Sub
--------------------------------------------------------------------------------------------------------------
Private Sub shuchu_Click()
Open "参数.doc" For Append Access Read Write As #1
'Print #1, "单元号 "; "体积 "; "密度 "; "比热 "; "单位发热率 "; "温度:已知(0)否(1) "; "温度值"
Print #1, danyuanhao.Text, tiji, midu, bire, danweifarelv, wendushifou, wenduzhi
Close #1

End Sub
-------------------------------------------------------------------------------------------------------------- Private Sub xuanzhe1_Click()
On Error Resume Next

UserForm1.Hide

Dim basePnt As Object

ThisDrawing.Utility.GetEntity entity, basePnt, "选择实体"

If Err.Number <> 0 Then
Err.Clear
MsgBox "图形不是块参照或未选中"
Exit Sub
End If

entity.Highlight (True)

Call 写入属性
userfom1.Show
End Sub
--------------------------------------------------------------------------------------------------------------
Sub 写入属性()
Dim blockobj As AcadBlock
Dim blockreference As AcadBlockReference

blockobj = ThisDrawing.Blocks.Add(entity.insertionPoint, "block" & entity.Handle)

Dim height As Double
Dim mode As Long
Dim prompt As String

Dim tag As String
Dim value As String

height = 1#
mode = acAttributeModeVerify

tag = "单元号"
prompt = tag
value = danyuanhao.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "体积"
prompt = tag
value = tiji.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "密度"
prompt = tag
value = midu.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "比热"
prompt = tag
value = bire.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "单位发热率"
prompt = tag
value = danweifarelv.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "温度:已知(0)否(1) "
prompt = tag
value = wendushifou.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

tag = "温度值"
prompt = tag
value = wenduzhi.Text
blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value

blockreference = blockobj.InsertBlock(entity.insertionPoint, entity.Name, entity.XScaleFactor, entity.YScaleFactor, entity.ZScaleFactor, entity.Rotation)

ThisDrawing.ModelSpace.InsertBlock entity.insertionPoint, blockobj.Name, 1#, 1#, 1#, 0

entity.Delete

Exit Sub

errorhandler:
MsgBox ("数据输入错误或图形不是块参照")
End Sub
--------------------------------------------------------------------------------------------------------------