masterli 发表于 2005-6-17 22:55:00

请问高手一个问题!急死小弟了!

以下是一个调cad画阶梯轴的activeX dll,里面有6个参数d1,d2,d3,l1,l2,l3,分别是阶梯轴的三段直径和长度,我想在asp里调用它,这个dll在vb里通过exe调试是可以用的,而到了asp调用时先是等好长时间,然后就告诉我
jtz 错误 '800a005b'
未设置对象变量或 With block 变量
/huatu.asp,行 20
vbdll如下:
Option Explicit
Dim AcadApp As AcadApplication
Dim Preference As AcadPreferences
Dim AcadDoc As AcadDocument
Dim MoSpace As AcadModelSpace
Dim PaSpace As AcadPaperSpace
Private d1_1 As Single
Private d2_1 As Single
Private d3_1 As Single
Private l1_1 As Single
Private l2_1 As Single
Private l3_1 As Single
Public Property Get d1() As Single
d1 = d1_1
End Property
Public Property Let d1(ByVal vNewValue As Single)
d1_1 = vNewValue
End Property
Public Property Get d2() As Single
d2 = d2_1
End Property
Public Property Let d2(ByVal vNewValue As Single)
d2_1 = vNewValue
End Property
Public Property Get d3() As Single
d3 = d3_1
End Property
Public Property Let d3(ByVal vNewValue As Single)
d3_1 = vNewValue
End Property
Public Property Get l1() As Single
l1 = l1_1
End Property
Public Property Let l1(ByVal vNewValue As Single)
l1_1 = vNewValue
End Property
Public Property Get l2() As Single
l2 = l2_1
End Property
Public Property Let l2(ByVal vNewValue As Single)
l2_1 = vNewValue
End Property
Public Property Get l3() As Single
l3 = l3_1
End Property
Public Property Let l3(ByVal vNewValue As Single)
l3_1 = vNewValue
End Property
Public Sub diaoyong()
Dim CLayer As AcadLayer '图层
Dim CTextStyle As AcadTextStyle '文本式样
Dim CDimStyle As AcadDimStyle '标注式样
Dim DimObj As AcadDimAligned '标注
Dim DwgName As String
Dim BP(0 To 2) As Double '基点
Dim CP1(0 To 2) As Double '中心点
Dim CP2(0 To 2) As Double
Dim P1(0 To 2) As Double '关键点
Dim P2(0 To 2) As Double
Dim P3(0 To 2) As Double
Dim P4(0 To 2) As Double
Dim P5(0 To 2) As Double
Dim P6(0 To 2) As Double
Dim P7(0 To 2) As Double
Dim P8(0 To 2) As Double
Dim P9(0 To 2) As Double
Dim P10(0 To 2) As Double
Dim P11(0 To 2) As Double
Dim P12(0 To 2) As Double
BP(0) = 0: BP(1) = 0: BP(2) = 0
P1(0) = BP(0): P1(1) = BP(1) - d1 / 2#
P2(0) = BP(0): P2(1) = BP(1) + d1 / 2#
P3(0) = BP(0) + l1: P3(1) = BP(1) - d1 / 2#
P4(0) = BP(0) + l1: P4(1) = BP(1) + d1 / 2#
P5(0) = BP(0) + l1: P5(1) = BP(1) - d2 / 2#
P6(0) = BP(0) + l1: P6(1) = BP(1) + d2 / 2#
P7(0) = BP(0) + l1 + l2: P7(1) = BP(1) - d2 / 2#
P8(0) = BP(0) + l1 + l2: P8(1) = BP(1) + d2 / 2#
P9(0) = BP(0) + l1 + l2: P9(1) = BP(1) - d3 / 2#
P10(0) = BP(0) + l1 + l2: P10(1) = BP(1) + d3 / 2#
P11(0) = BP(0) + l1 + l2 + l3: P11(1) = BP(1) - d3 / 2#
P12(0) = BP(0) + l1 + l2 + l3: P12(1) = BP(1) + d3 / 2#
CP1(0) = BP(0) - 5: CP1(1) = BP(1)
CP2(0) = BP(0) + l1 + l2 + l3 + 5: CP2(1) = BP(1)
                       
                       '1.连接
                               Call 连接AutoCAD
       
                               '2.新建AutoCAD文件
                               DwgName = App.Path & "\ini.dwt"
                               Call NewDwg(DwgName)
                                       
                                       '4设定当前层,画实线
                               Set CLayer = AcadDoc.Layers.Item("01")
                               AcadDoc.ActiveLayer = CLayer
                               MoSpace.AddLine P1, P2
                               MoSpace.AddLine P1, P3
                               MoSpace.AddLine P2, P4
                               MoSpace.AddLine P5, P6
                               MoSpace.AddLine P5, P7
                               MoSpace.AddLine P6, P8
                               MoSpace.AddLine P9, P10
                               MoSpace.AddLine P9, P11
                               MoSpace.AddLine P10, P12
                               MoSpace.AddLine P11, P12
                               
                               Set CLayer = AcadDoc.Layers.Item("04")
                               AcadDoc.ActiveLayer = CLayer
                                       MoSpace.AddLine CP1, CP2
                                       
                                       '标注尺寸
                               Dim Textlocation(0 To 2) As Double
                               Dim ExtLinePoint1(0 To 2) As Double
                               Dim ExtLinePoint2(0 To 2) As Double
                               Dim DimText As Double
                               Set CLayer = AcadDoc.Layers.Item("05") '设定当前层
                               AcadDoc.ActiveLayer = CLayer
                               'Set CDimStyle = AcadDoc.DimStyles.Item("sta")       '设定标注式样
                       ' AcadDoc.ActiveDimStyle = CDimStyle
                               
                               Textlocation(0) = P1(0) + 10: Textlocation(1) = 0: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P1, P2, Textlocation)
                       
                               
                               Textlocation(0) = P4(0) + 10: Textlocation(1) = 0: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P5, P6, Textlocation)
                               
                               Textlocation(0) = P8(0) + 10: Textlocation(1) = 0: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P9, P10, Textlocation)
                       
                               Textlocation(0) = 0: Textlocation(1) = P2(1) + 15: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P2, P4, Textlocation)
                       
                               Textlocation(0) = 0: Textlocation(1) = P2(1) + 15: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P6, P8, Textlocation)
                               
                               Textlocation(0) = 0: Textlocation(1) = P2(1) + 15: Textlocation(2) = 0
                               Set DimObj = MoSpace.AddDimAligned(P10, P12, Textlocation)
                               
End Sub
Private Sub 连接AutoCAD()
                       On Error Resume Next
                       Set AcadApp = GetObject(, "Autocad.Application")
                       If Err Then
                                                       Err.Clear
                                                       Set AcadApp = CreateObject("Autocad.Application")
                                                       If Err Then
                                                                                       MsgBox ("不能运行AutoCAD,请检查是否安装了AutoCAD!")
                                                                                       Exit Sub
                                                       End If
                       End If
                       AcadApp.Visible = True '不可见
                       'AcadApp.ActiveDocument.Close (True)
End Sub
Private Sub NewDwg(DwgName As String)
                       On Error Resume Next
                       AcadApp.Documents.Add DwgName
                       AppActivate AcadApp.Caption
                       
                       Set Preference = AcadApp.Preferences       '对象引用
                       Set AcadDoc = AcadApp.ActiveDocument
                       Set MoSpace = AcadDoc.ModelSpace
                       Set PaSpace = AcadDoc.PaperSpace
End Sub相关asp如下:

雪山飞狐_lzh 发表于 2005-6-21 21:07:00

用VB工程调试过了么?我这里没装VB:),你先调一下
页: [1]
查看完整版本: 请问高手一个问题!急死小弟了!