关于SendCommand命令的用法,代码如下。
Public Function axPoint2lspPoint(ByVal Pnt As Variant) As String
axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function
Public Function axEnt2lspEnt(ByVal entObj As AcadEntity) As String
Dim enthandle As String
enthandle = entObj.Handle
axEnt2lspEnt = "(handent" & Chr(34) & enthandle & Chr(34) & ")"
End Function
Public Function GetDoubleEntTable(ByVal entObj As AcadEntity, ByVal Pnt As Variant) As String
Dim enthandle As String
enthandle = entObj.Handle
GetDoubleEntTable = "(list(handent" & Chr(34) & enthandle & Chr(34) & ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
End Function
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
Public Sub Break()
Dim Pnt As Variant
Dim entObj As AcadEntity
ThisDrawing.Utility.GetEntity.entObj , Pnt, vbCrLf & "选择图元:"
Dim Pnt2 As Variant
Pnt2 = ThisDrawing.Utility.GetPoint(, vbvrlf & "选择点:")
Dim det As String
det = GetDoubleEntTable(entObj, Pnt)
Dim lspPnt As String
lspPnt = axPoint2lspPoint(Pnt2)
ThisDrawing.SendCommand ("_break" & vbCr & det & vbCr & lspPnt & vbCr)
End Sub
Public Sub Trim()
On Error Resume Next
Dim SSet As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("trim")) Then
Set SSet = ThisDrawing.SelectionSets.Item("trim")
SSet.Delete
End If
Set SSet = ThisDrawing.SelectionSets.Add("trim")
SSet.SelectOnScreen
Dim det1 As String
det1 = axSSet2lspEnts(SSet)
SSet.Delete
Dim Pnt2 As Variant
Dim entObj2 As AcadEntity
ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择背剪图元:"
Dim det2 As String
det2 = GetDoubleEntTable(entObj2, Pnt2)
ThisDrawing.SendCommand "_trim" & vbCr & det1 & det1 & vbCr & vbCr & det2 & vbCr & vbCr
End Sub
代码完。