- 积分
- 215
- 明经币
- 个
- 注册时间
- 2005-5-21
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
以下是一个调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.连接AutoCAD 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如下:
<% Dim objSum Set objSum = Server.CreateObject("jtz.jtzcad") objSum.d1 = 10 objSum.d2 = 20 objSum.d3 = 30 objSum.l1 = 10 objSum.l2 = 10 objSum.l3 = 10 objSum.diaoyong Set objSum = Nothing %> |
|