功能函数参数不能传递
想用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