关于trim功能的运用
根据看到的帖子,我做了一个vb实现trim功能的程序.基本思路如下:先做出一个封闭的矩形polyline,然后用sendcommand命令,边界选用此矩形,然后用"F"命令,输入比矩形polyline四个顶点稍靠内的四个点坐标,这样矩形polyline范围内所有能剪切的实体都被截断.
这样做如果是在cad命令行中操作,一切正常.但通过vb程序操作时,cad会出现一个对话框"Can't run macro,AutoCAD is busy",点击确定后对话框消失,程序结束.然后再在命令行中输入一个回车,命令行的trim命令结束.此时polyline内的实体被截断,达到预定目标.
请问这个对话框是怎么回事,怎样避免?它对我的程序无用,除去就大吉了. 另外,刚刚调试时发现,如果一个实体,比如多义线,来回几次穿过剪切边界时,用"F"一次只能截断一次穿过剪切边界的部分,再"F"一次又截断一部分,就跟用点选取一样.由于不能事先知道有几次穿过,也就是说不能确定要"F"几次.各位有什么办法解决吗?
注:在命令行执行trim命令,情况一样. 我也做了一个和你一样的程序，编程的思路也一样，不过我是用vba做的，已经调试成功，没有可以直接使用了。
你说的那个多段线多次穿过的问题我也遇到了，还没有解决，在程序里我用了2次截断，对于穿过边界的一般的多段线是够用了。
下面是我的程序代码，如果方便可以和楼主交流一下，看看怎么才能做的更好。
Sub blkTrim()
On Error Resume Next
Dim ent As AcadEntity
Dim sset As AcadSelectionSet
Set sset = CreateSelectionSet("sset")
Dim fType, fData As Variant
Dim lwplineobj As AcadLWPolyline
Dim pt1, pt2 As Variant
Dim points(0 To 9) As Double
Dim isblock As Boolean
BuildFilter fType, fData, 0, "INSERT"
ThisDrawing.Utility.Prompt "选择对象，会过滤其它对象，只留下块，若直接回车，则可选择多段线。"
sset.SelectOnScreen fType, fData
If sset.Count = 0 Then
ThisDrawing.Utility.Prompt "选择对象，会过滤其它对象，只留下多段线。"
BuildFilter fType, fData, 0, "lwPolyline"
sset.SelectOnScreen fType, fData
If sset.Count = 0 Then Exit Sub
For Each ent In sset
entTrimF ent
Next
Else
For Each ent In sset
ent.GetBoundingBox pt1, pt2
points(0) = pt1(0): points(1) = pt1(1)
points(2) = pt1(0): points(3) = pt2(1)
points(4) = pt2(0): points(5) = pt2(1)
points(6) = pt2(0): points(7) = pt1(1)
points(8) = pt1(0): points(9) = pt1(1)
Set lwplineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
entTrimF lwplineobj
lwplineobj.Delete
Next
End If
sset.Delete
End Sub
'此过程把和多段线plineobj相交的线都剪切
Sub entTrimF(plineObj As AcadEntity)
Dim offplineObj As Variant
Dim copyplineobj As AcadEntity
Dim Coors As Variant
Dim coorString, cmdString As String
Dim i As Integer
Dim offdist As Double
Set copyplineobj = plineObj.Copy
If IsClockWise(copyplineobj) Then offdist = 0.01 Else: offdist = -0.01
offplineObj = copyplineobj.Offset(offdist)
offplineObj(0).Update
Coors = offplineObj(0).Coordinates
offplineObj(0).Delete
copyplineobj.Delete
coorString = ""
For i = LBound(Coors) To UBound(Coors) Step 2
coorString = coorString & Coors(i) & "," & Coors(i + 1) & ",0" & vbCr
Next i
cmdString = "trim" & vbCr & "(handent """ & plineObj.Handle & """)" & vbCr & vbCr & _
"f" & vbCr & coorString & vbCr & vbCr
ThisDrawing.SendCommand cmdString
ThisDrawing.SendCommand cmdString
End Sub
以下是引用的函数，基本上都是从明经下载的，根据自己的要求做了一些改动。呵呵
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
Dim fType() As Integer, fData()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
Next
typeArray = fType: dataArray = fData
End Sub
Public Sub ssDelete(ss As AcadSelectionSet, ent As AcadEntity)
Dim objArray(0 To 0) As AcadEntity
Set objArray(0) = ent
ss.RemoveItems objArray
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function
Public Function IsClockWise(objEntity As AcadEntity) As Boolean
On Error Resume Next
Dim NewObj As Variant
Dim oldobj As AcadEntity
Set oldobj = objEntity.Copy
NewObj = oldobj.Offset(-0.01)
Dim Area1 As Double
Dim Area2 As Double
Area1 = objEntity.Area
Area2 = NewObj(0).Area
Dim i As Integer
For i = 0 To UBound(NewObj)
NewObj(i).Delete
Next
oldobj.Delete
If Area1 < Area2 Then IsClockWise = True
End Function
3楼,我想你可能还没有对你的程序进行多种情况下的测试.比如弧线,各种线宽的多义线(线宽小于剪切范围,线宽大于剪切范围,线宽一部分在剪切范围内等)等等.另外我发现,用"F"时偏移量的多少(0.001和0.1)剪切的结果有时候也不一样.你试试你的看.
另外给个建议,你现在是用"F"时选择了一圈,这样对于反复穿越的线只算一次,而改为"F"时一次只输入一段,多"F"几次,这样同样是选择一圈,"F"的次数却不同.还有你选择时没有回到第一点,是个未封闭区域,应该再把第一点加在最后.
对于需要多次剪切的问题,我也没办法.多次剪切总归不是治本之道.
关于此程序,有什么新的思路,欢迎与我交流. 4楼说得对，我的多义线几乎都不用宽度的。所以有线宽的多义线都没有测试过。这个程序主要是让自己绘图时能快一些。所以一些自己不会遇到的情况都没有测试。封闭的弧形我试过是可以的。
偏移量的多少好像没有关系，一般的图几乎没有会用到0.01以下的数值。所以只要偏移的精度达到0.01就应该没有问题了。
页:
[1]