标题:功能函数参数不能传递
只看楼主
loyxqing
Rank: 1
等 级:新手上路
帖 子:14
专家分:0
注 册:2022-3-10
结帖率:100%
 问题点数:0 回复次数:0 
功能函数参数不能传递
想用VB控制AUTOCAD,按照书上的教程写了段代码,不知道为什么功能函数不能传递到运行代码中,求组下论坛里的大侠们。
’'功能函数提取图形句柄处理成LSP模式
Public Function axSSet2lspEnts(ByVal SSet As AcadSelectionSet) As String
If SSet.Count = 0 Then Exit Function
Dim enthandle As String
Dim strEnts As String
enthandle = SSet.Item(0).Handle
strEnts = "(handent" & Chr(34) & enthandle & Chr(34) & ")"
If SSet.Count > 1 Then
Dim i As Integer
For i = 1 To SSet.Count - 1
enthandle = SSet.Item(i).Handle
strEnts = strEnts & vbCr & "(handent " & Chr(34) & enthandle & Chr(34) & ")"
Next i
End If
axSSet2lspEnts = strEnts
End Function
Private Sub Command2_Click()
Dim arrcolor
Dim arrlayer
Dim objLayers As AcadLayers
Dim SSET As AcadSelectionSet
Dim CircleObject As AcadCircle
Dim GroupObject As AcadGroup
Dim ObjectsForGroup() As AcadEntity
Set acadapp = GetObject(, "AutoCAD.Application")
    If Err Then
        Err.Clear
        Set acadapp = CreateObject("AutoCAD.Application")
        If Err Then
            MsgBox Err.Description
            Exit Sub
        End If
    End If
    acadapp.Visible = True
Set acadDoc = acadapp.ActiveDocument
Set acadMOS = acadDoc.ModelSpace
Set objLayers = acadDoc.Layers
'''''------------------字体设置------------------
Dim mytxt As AcadTextStyle
On Error Resume Next
    Set mytxt = acadDoc.TextStyles.Add("mytxt")
    mytxt.fontFile = "c:\windows\fonts\Arial.ttf"
    acadDoc.ActiveTextStyle = mytxt
On Error GoTo 0
AppActivate acadapp.Caption     '激活当前CAD窗口
Angle = Val(Txt_angle)
    On Error Resume Next
        If Not IsNull(acadDoc.SelectionSets.Item("GROUP")) Then
            Set SSET = acadDoc.SelectionSets.Item("GROUP")
            SSET.Delete
        End If
    On Error GoTo 0
    s = 6500   ''' ''面积
    Angle1 = Val(Txt_angle1)          '''''角度a1
    Angle2 = Val(Txt_angle2)          '''''角度a2
    Radia_fan = (90 + Angle1 + Angle2) * pi / 360       '''''幅度*2
    A_TRI1 = Sin(Angle1 * pi / 180)     '''''角度a1正弦
    A_TRI2 = Sin(Angle2 * pi / 180)     '''''角度a2正弦
    B_TRI1 = Cos(Angle1 * pi / 180)     '''''角度a1余弦
    B_TRI2 = Cos(Angle2 * pi / 180)     '''''角度a2余弦   
    R = Sqr(s / (Radia_fan + (A_TRI2 * (A_TRI1 + B_TRI2)) / 2))
   
    Dim centerpoint(0 To 2) As Double
    Dim linepoint(0 To 5) As Double
    acadDoc.ActiveLayer = objLayers.Item("0")     '''''0层
          centerpoint(0) = -200: centerpoint(1) = 200 : centerpoint(2) = 0
'''''线段坐标
        linepoint(0) = centerpoint(0) - B_TRI2 * R: linepoint(1) = centerpoint(1) - A_TRI2 * R
        linepoint(2) = centerpoint(0): linepoint(3) = centerpoint(1) - A_TRI2 * R
        linepoint(4) = centerpoint(0) + A_TRI1 * R: linepoint(5) = centerpoint(1) + B_TRI1 * R
    Dim arcRS As AcadEntity
    Dim plineRS As AcadEntity
    Dim plineobj As AcadEntity
    Dim RSdet As String
    Set SSET = acadDoc.SelectionSets.Add("GROUP")   
        Set arcRS = acadMOS.AddArc(centerpoint, R, (90 - Angle1) * pi / 180, (180 + Angle2) * pi / 180)
        Set plineRS = acadMOS.AddLightWeightPolyline(linepoint)
        SSET.SelectOnScreen
        Dim DRSdet As String
            RSdet = axSSet2LspEnts(SSET)  ’'代码在这里不能从功能函数调用中传递出计算结果,RSdet的结果为空,
            SSET.Delete
            acadDoc.SendCommand "pedit" & vbCr & "M" & vbCr & RSdet & vbCr & vbCr & "J" & vbCr & vbCr & vbCr
End Sub
搜索更多相关主题的帖子: Dim If End 函数 Set 
2022-07-13 21:22



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-509561-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.050871 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved