请看看该程序到底什么问题?
是根据VBA教材的代码改的批量裁剪程序问题:达不到裁减效果(我想把多边行内的线条裁剪掉),但有时候又可以,纳闷!
Sub Trim()
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocument
Set acadapp = connectcad(acadapp)
Set acaddoc = acadapp.ActiveDocument
AppActivate acadapp.Caption '让CAD得到焦点
Dim Pnt1 As Variant
Dim entObj1 As AcadEntity
acaddoc.Utility.GetEntity entObj1, Pnt1, "选择修剪边界:"
Dim det1 As String
det1 = axEnt2lspEnt(entObj1)
Dim Pnt2 As Variant
Dim entObj2 As AcadEntity
Dim sle1 As AcadSelectionSet
On Error Resume Next
Set sle1 = acaddoc.SelectionSets.Item("sle1")
sle1.Clear
If Err Then
Err.Clear
Set sle1 = acaddoc.SelectionSets.Add("sle1")
End If
acaddoc.Utility.Prompt "选择需要修剪的对象" & Chr(13)
sle1.SelectOnScreen
Pnt2 = acaddoc.Utility.GetPoint(, "选择修剪方向")
Dim det2 As String
For Each entObj2 In sle1
det2 = GetDoubleEntTable(entObj2, Pnt2)
acaddoc.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
Next
Dim command_str As String
command_str = Chr(3) & Chr(3)
acaddoc.SendCommand command_str
acaddoc.Utility.Prompt "修剪完成!"
acaddoc.SendCommand command_str
Set acadapp = Nothing
End
End Sub
'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, 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 axPoint2lspPoint(Pnt As Variant) As String
axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function
'转换图元函数
Public Function axEnt2lspEnt(entObj As AcadEntity) As String
Dim entHandle As String
entHandle = entObj.Handle
axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
Function connectcad(acadapp As AcadApplication) As AcadApplication '连接AUTOCAD
On Error Resume Next
'与autocad通信
Set acadapp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Function
End If
End If
Set connectcad = acadapp
End Function
Private Sub Form_Initialize()
Trim
End Sub 是不是“转换双元表的函数”不能完全达到效果呢? 你的程序本身有问题:
在选择修剪方向时,其实你只认定了一个点Pnt2,然后你就使用该点组成了修剪的双元表,这样的话,对于被修剪对象来说,可能会产生点取的点在外部的问题,因为系统认定的点取的位置是Pnt2到被修剪对象上的垂直点的位置。
要达到效果,应该是:
点取一个点Pnt2后,把多段线向内偏移一小段距离,然后逐条遍历被修剪对象的选择集,求选择集中的对象与偏移的对象的交点,再通过交点来组成双元表,这样的话,应该可以解决。 :)非常感谢!其实我还是不了解“双元表”的概念,不知道是什么东西,有什么用,因为都找不到这方面的参考书 双元表也就是指在进行一些对象操作时对位置有要求时使用数据格式
页:
[1]