批量绘图出现问题请教
原来写的用VBA作对话框调用LSP批量绘断面图在CASS8 FOR ACAD2006上运行的很好,现在将他移植到CASS9.1 FOR ACAD2012 上时,出现自动化错误,该按钮的代码如下,请高人指教!Private Sub Button1_Click()
Dim ffdmjs As Integer, CXM As String, F As String, i As Integer, k As Integer, kk As String, cbz As String
Dim dm() As String
On Error GoTo a0
cbz = ""
If Opt98.Value = True Then cbz = "Y"
XMMC = RText1: ddmc = RText2
pmzbx = RText3: gczbx = RText4
TZG = Text1: TZK = Text2
zxb = Text3: HXB = Text4
yy0 = Text5: xx0 = Text7
dmjg = Val(Text6.Text)
CXM = CASS9PathB & "/system/断面绘图91.LSP"
F = wjjmc1
绘横断面对话框.Hide
Ccs = ListBox2.Text
Ccs0 = Val(Mid$(Ccs, 3, 1))
bchtcswj
Call bchtqtcswj(Ccs0)
ffdms(0) = 0: ffdmjs = 1: djf = 0
For i = 0 To ListBox1.ListCount - 1
djf = djf + 1
Application.Documents.Add'执行这句时出现自动化错误
tfh0 = ListBox1.List(i)
If tfh0 = tfh(djf) Then
ffdmjs = ffdmjs + ffdms(i)
ffdms(0) = ffdms(djf)
Call wffwj(ffdmjs)
Call wdmwj(ffdmjs)
ThisDrawing.SendCommand "(" & "LOAD" & Chr(34) & CXM & Chr(34) & ")" & vbCr
ThisDrawing.SendCommand "(setq cbz0 " & Chr(34) & cbz & Chr(34) & ")" & vbCr
ThisDrawing.SendCommand "_dmt" & vbCr
End If
kk = qtfh(tfs, djf)
Application.ActiveDocument.Close True, F & kk & ".dwg"
Next i
a0:
End Sub
这一句 Application.Documents.Add 已经解决:
Application.Documents.Add 【加模板图,如 “acadiso.dwt”】
页:
[1]