|
|
以下是一个调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如下:
|
|
置顶卡
