在VB中遇到的问题
我在网上找到了一个关于VB调用CAD图库的问题，然后源码打开后，显示装配有问题。现把源码附上，打开图的时候出现问题。请各位大神看看是什么问题。谢谢啦。每次打开是总是出现“对象变量或with块变量未设置”'各带总图装配
Private Sub Command6_Click()
copy_move.yc_1.Text = yaolucanshu.yc_1.Text
copy_move.yc_2.Text = yaolucanshu.yc_2.Text
copy_move.yc_3.Text = yaolucanshu.yc_3.Text
copy_move.sc_1.Text = yaolucanshu.sc_1.Text
copy_move.sc_2.Text = yaolucanshu.sc_2.Text
copy_move.lc_1.Text = yaolucanshu.lc_1.Text
copy_move.lc_2.Text = yaolucanshu.lc_2.Text
copy_move.lc_3.Text = yaolucanshu.lc_3.Text
copy_move.mjyc.Caption = Val(yaolucanshu_1.mjc.Text) + Val(yaolucanshu_1.jlc.Text)
Dim yqc As Double, yzc As Double, sqc As Double, jlc As Double, hlc As Double
yqc = 232 * Val(yaolucanshu.yc_1.Text)
yzc = 232 * Val(yaolucanshu.yc_2.Text)
sqc = 232 * Val(yaolucanshu.sc_1.Text)
jlc = 232 * Val(yaolucanshu.lc_1.Text)
hlc = 232 * Val(yaolucanshu.lc_2.Text)
Dim objCurDoc As AcadDocument
Dim objNewDoc As AcadDocument
Dim objLastDoc As AcadDocument
Select Case True
Case Option1(0).Value
AutoCAD_Appliaction
' 打开第一张图
Set objCurDoc = acadapp.Documents.Open(App.Path & "\Gallery\预热带前段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.yc_1.Text), "0"
' 打开一个新图形
Set objNewDoc = acadapp.Documents.Open(App.Path & "\Gallery\预热带中段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.yc_2.Text), "0"
moveSset "NEW1", yqc
'打开最后一个图形
Set objLastDoc = acadapp.Documents.Open(App.Path & "\Gallery\预热带后段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.yc_3.Text), "0"
moveSset "NEW1", yzc + yqc
Set objNewDoc = acadapp.ActiveDocument
' 将外部图形的实体复制到当前图形
Set ssetobj = CreateSelectionSet
ssetobj.Select acSelectionSetAll
acadapp.ActiveDocument.CopyObjects ssArray(ssetobj), objCurDoc.ModelSpace
objCurDoc.Regen acAllViewports
' 关闭打开的图形
objNewDoc.Close (False)
Set objLastDoc = acadapp.ActiveDocument
Set ssetobj = CreateSelectionSet
ssetobj.Select acSelectionSetAll
acadapp.ActiveDocument.CopyObjects ssArray(ssetobj), objCurDoc.ModelSpace
objCurDoc.Regen acAllViewports
objLastDoc.Close (False)
Case Option1(1).Value
AutoCAD_Appliaction
' 打开第一张图
Set objCurDoc = acadapp.Documents.Open(App.Path & "\Gallery\烧成带前段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.sc_1.Text), "0"
' 打开一个新图形
Set objNewDoc = acadapp.Documents.Open(App.Path & "\Gallery\烧成带保温段.dwg")
copy_moveSset "NEW1", 183, Val(copy_move.sc_2.Text), "0"
moveSset "NEW1", sqc
Set objNewDoc = acadapp.ActiveDocument
' 将外部图形的实体复制到当前图形
Set ssetobj = CreateSelectionSet
ssetobj.Select acSelectionSetAll
acadapp.ActiveDocument.CopyObjects ssArray(ssetobj), objCurDoc.ModelSpace
objCurDoc.Regen acAllViewports
' 关闭打开的图形
objNewDoc.Close (False)
Case Option1(2).Value
AutoCAD_Appliaction
' 打开第一张图
Set objCurDoc = acadapp.Documents.Open(App.Path & "\Gallery\急冷段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.lc_1.Text) - 1, "0"
' 打开一个新图形
Set objNewDoc = acadapp.Documents.Open(App.Path & "\Gallery\缓冷段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.lc_2.Text), "0"
moveSset "NEW1", jlc
'打开最后一个图形
Set objNewDoc = acadapp.Documents.Open(App.Path & "\Gallery\快冷段.dwg")
copy_moveSset "NEW1", 232, Val(copy_move.lc_3.Text), "0"
moveSset "NEW1", jlc + hlc
Set objNewDoc = acadapp.ActiveDocument
' 将外部图形的实体复制到当前图形
Set ssetobj = CreateSelectionSet
ssetobj.Select acSelectionSetAll
acadapp.ActiveDocument.CopyObjects ssArray(ssetobj), objCurDoc.ModelSpace
objCurDoc.Regen acAllViewports
' 关闭打开的图形
objNewDoc.Close (False)
Set objLastDoc = acadapp.ActiveDocument
Set ssetobj = CreateSelectionSet
ssetobj.Select acSelectionSetAll
acadapp.ActiveDocument.CopyObjects ssArray(ssetobj), objCurDoc.ModelSpace
objCurDoc.Regen acAllViewports
objLastDoc.Close (False)
End Select
End Sub
页:
[1]