[VBA]帮忙修改一下程序
这是我仿照VB.NET程序在VBA里编的程序，运行是出编译错误，各位大虾帮忙改改！Dim entity As AcadEntity<BR>--------------------------------------------------------------------------------------------------------------<BR>Sub 读取属性()<BR> Me.danyuanhao.Text = ""<BR> Me.tiji.Text = ""<BR> Me.midu.Text = ""<BR> Me.bire.Text = ""<BR> Me.danweifarelv = ""<BR> Me.wendushifou = ""<BR> Me.wenduzhi = ""<BR> <BR> Dim varattributes As Object<BR> varattributes = entity.GetAttributes<BR> Dim i As Integer<BR> For i = LBound(varattributes) To UBound(varattributes)<BR> Select Case varattributes(i).TagString<BR> Case "单元号"<BR> Me.danyuanhao.Text = varattribute(i).TextString<BR> Case "体积"<BR> Me.tiji.Text = varattribute(i).TextString<BR> Case "密度"<BR> Me.midu.Text = varattribute(i).TextString<BR> Case "比热"<BR> Me.bire.Text = varattribute(i).TextString<BR> Case "单位发热率"<BR> Me.danweifarelv.Text = varattribute(i).TextString<BR> Case "温度:已 知(0)否(1)"<BR> Me.wendushifou.Text = varattribute(i).TextString<BR> Case "温度值"<BR> Me.wenduzhi.Text = varattribute(i).TextString<BR> End Select<BR> Next<BR> entity.Highlight (False)<BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------<BR>Private Sub chaxun1_Click()<BR> On Error Resume Next<BR> <BR> UserForm1.Hide<BR> <BR> Dim basePnt As Object<BR> <BR> ThisDrawing.Utility.GetEntity entity, basePnt, "选择实体"<BR> <BR> If Err.Number <> 0 Then<BR> Err.Clear<BR> MsgBox "图形不是块参照或未选中"<BR> Exit Sub<BR> End If<BR> entity.Highlight (True)<BR> Call 读取属性<BR> <BR> UserForm1.Show<BR> <BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------<BR>Private Sub end1_Click()<BR>End<BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------<BR>Private Sub MultiPage1_Change()
End Sub<BR>--------------------------------------------------------------------------------------------------------------<BR>Private Sub shuchu_Click()<BR>Open "参数.doc" For Append Access Read Write As #1<BR>'Print #1, "单元号 "; "体积 "; "密度 "; "比热 "; "单位发热率 "; "温度:已知(0)否(1) "; "温度值"<BR>Print #1, danyuanhao.Text, tiji, midu, bire, danweifarelv, wendushifou, wenduzhi<BR>Close #1<BR> <BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------
Private Sub xuanzhe1_Click()<BR> On Error Resume Next<BR> <BR> UserForm1.Hide<BR> <BR> Dim basePnt As Object<BR> <BR> ThisDrawing.Utility.GetEntity entity, basePnt, "选择实体"<BR> <BR> If Err.Number <> 0 Then<BR> Err.Clear<BR> MsgBox "图形不是块参照或未选中"<BR> Exit Sub<BR> End If<BR> <BR> entity.Highlight (True)<BR> <BR> Call 写入属性<BR> userfom1.Show<BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------<BR>Sub 写入属性()<BR> Dim blockobj As AcadBlock<BR> Dim blockreference As AcadBlockReference<BR> <BR> blockobj = ThisDrawing.Blocks.Add(entity.insertionPoint, "block" & entity.Handle)<BR> <BR> Dim height As Double<BR> Dim mode As Long<BR> Dim prompt As String<BR> <BR> Dim tag As String<BR> Dim value As String<BR> <BR> height = 1#<BR> mode = acAttributeModeVerify<BR> <BR> tag = "单元号"<BR> prompt = tag<BR> value = danyuanhao.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "体积"<BR> prompt = tag<BR> value = tiji.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "密度"<BR> prompt = tag<BR> value = midu.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "比热"<BR> prompt = tag<BR> value = bire.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "单位发热率"<BR> prompt = tag<BR> value = danweifarelv.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "温度:已知(0)否(1) "<BR> prompt = tag<BR> value = wendushifou.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> tag = "温度值"<BR> prompt = tag<BR> value = wenduzhi.Text<BR> blockobj.AddAttribute height, mode, prompt, entity.insertionPoint, tag, value<BR> <BR> blockreference = blockobj.InsertBlock(entity.insertionPoint, entity.Name, entity.XScaleFactor, entity.YScaleFactor, entity.ZScaleFactor, entity.Rotation)<BR> <BR> ThisDrawing.ModelSpace.InsertBlock entity.insertionPoint, blockobj.Name, 1#, 1#, 1#, 0<BR> <BR> entity.Delete<BR> <BR> Exit Sub<BR> <BR>errorhandler:<BR> MsgBox ("数据输入错误或图形不是块参照")<BR>End Sub<BR>--------------------------------------------------------------------------------------------------------------
页:
[1]