社区 › VB › 边界内的修剪和删除

Sundar 发表于 2012-1-27 07:52:07

边界内的修剪和删除

大家好，
我是这个论坛的新成员，这是我的第一篇帖子..希望我能从你们那里得到更好的回复..我的任务来了...
我只需要编写一个VBA代码，该代码将修剪与用户选择的矩形边界相交的线条。边界外的所有其他对象或线/Pline将被删除，穿过边界的线将被修剪掉。与“EXTRIM”命令完全相同。我需要通过VBA或LISP来完成..请帮我一把.....
预先感谢............
**** Hidden Message *****

Matt__W 发表于 2012-1-27 08:24:09

在LSP中应该很容易做到(因为不支持VBA)。
您已经有EXTRIM，所以现在另一个缺失的部分正在清除边界外的所有内容。很容易做到。只需启动ERASE命令，然后键入'EXW(包括撇号)，然后指定一个窗口的两个角(您的边界)，然后*噗！*边界外的所有内容都被删除。

Sundar 发表于 2012-1-27 23:08:54

非常感谢...你能提供LISP代码吗...我不太了解LISP...在VBA中工作...所以...............谢谢......

ChuckHardin 发表于 2012-1-30 12:41:26

我有一些旧代码，你可以看看，那是VBA。它将删除所有未选定的实体
Public Sub EraseUnselected()
Dim objSelSet As AcadSelectionSet
Dim objUnSelectedSet As AcadSelectionSet
Dim objEnts() As AcadEntity
Dim lngCnt As Long
On Error GoTo Err_Control
Set objSelSet = ThisDrawing.PickfirstSelectionSet
Set objUnSelectedSet = ThisDrawing.SelectionSets.Add("Unselected")

objSelSet.SelectOnScreen
objUnSelectedSet.Select acSelectionSetAll

ReDim objEnts(0 To objSelSet.Count - 1) As AcadEntity
For lngCnt = 0 To objSelSet.Count - 1
      Set objEnts(lngCnt) = objSelSet(lngCnt)
Next lngCnt

objUnSelectedSet.RemoveItems objEnts
objUnSelectedSet.Erase
objSelSet.Delete
objUnSelectedSet.Delete

Exit_Here:
Exit Sub

Err_Control:
Select Case Err.Number
      Case -2145320851
         For lngCnt = 0 To ThisDrawing.SelectionSets.Count - 1
                If ThisDrawing.SelectionSets.Item(lngCnt).Name = "Unselected" Then
                     Set objUnSelectedSet = ThisDrawing.SelectionSets.Item(lngCnt)
                     Resume Next
                Else
                     Resume Exit_Here
                End If
         Next
      Case Else
         InputBox Err.Description, "Erase Unselected", Err.Number
         Resume Exit_Here
End Select

End Sub

Sundar 发表于 2012-1-31 06:30:52

谢谢你的代码chuckhardin...让我用这个敲我的头，我会回来的...

Sundar 发表于 2012-2-1 01:24:43

我试着用你的代码来完成我的任务...但是需要选择不应该删除的对象...所有其他的都将被删除...这是我尝试过的...
ThisDrawing.SendCommand"_extrim"&vbCr
这将做我想要的wat的主要任务，保留修剪和外部边界对象...我不想删除所有其他的... ur代码需要用户选择要保留的对象...任何更多的建议都会很有帮助...谢谢...

ChuckHardin 发表于 2012-2-1 09:13:21

尽可能远离SendCommand语句。
换句话说，您可以修改宏，采用边界框修剪所有实体，然后删除不在该框中的实体。你可以用a框来选择。用户需要选择该框吗？盒子是不是在一个特殊的图层上，上面没有任何其他对象？
对于erase
Public Sub EraseUnselected(varLL as variant，varUR as variant)
varLL是边界框的左下角
varUR是边界框的右上角
然后修改objSelSet。选择屏幕上的
以使用objSelSet。Select acSelectionSetCrossing，varLL，varUR
此方法支持过滤机制。
以下选择模式可用:
窗口
选择完全位于矩形区域内的所有对象，矩形区域的角由点1和点2定义。交叉选择矩形区域内并与之交叉的对象，矩形区域的角由点1和点2定义。上一个选择最近的选择集。如果在图纸空间和模型空间之间切换并尝试使用选择集，此模式将被忽略。
最后
选择最近创建的可见对象。全部选择所有对象。

Sundar 发表于 2012-2-2 00:22:14

但是我需要修剪掉穿过多边形的线，EXTRIM会做得很好..所以我必须用它..让我公布一下我到目前为止所做的工作..它几乎完成了我想要的任务..但是EXTRIM命令的边是随机选取的..有时，它会修剪和删除边界内的线条..我总是想在边界外修剪..欢迎对宏进行任何修改..Public Sub EraseUnselected()
Dim objSelSet As AcadSelectionSet
Dim objunselected Set As AcadSelectionSet
Dim objEnts()As acad entity
Dim LNG CNT As Long，Coords As Variant，new _ ent As acad entity
Dim Pt3 As Variant，Pt1 As Variant，wanted _ ent As acad entity
Dim polygon line As acadlw polyline，polygon Coords As Variant
Dim lwl pline As acadlw polyline
Dim varall As Variant，varUR设置objUnSelectedSet = ThisDrawing。SelectionSets.Add("未选定")

objSelSet。选择屏幕上的“对象集合”。Select acSelectionSetCrossing，varLL，varUR objUnSelectedSet。select acSelectionSetAll

ReDim objEnts(0到objSelSet。Count - 1)作为acad entity

For LNG CNT = 0 To objSelSet。count-1

Set objEnts(LNG CNT)= objSelSet(LNG CNT)
Set new _ ent = objEnts(LNG CNT)
Set polygon line = new _ ent
new _ ent。GetBoundingBox Pt3，Pt1
本图。send command " _ extrim " & vbCr & Pt1(0)& "，" & Pt1(1) & vbCr & Pt3(0) & "，" & Pt3(1) & vbCr

下一个LNG CNT


objUnSelectedSet。RemoveItems Unwanted_ent。擦除objSelSet。删除objUnSelectedSet。delete

Exit _ Here:
Exit Sub

Err _ Control:
Select Case Err。本图纸中lngCnt = 0的编号。selections sets . Count-1
如果该绘图。SelectionSets.Item(lngCnt)。Name = "Unselected "然后
设置objUnSelectedSet = ThisDrawing。selection sets . Item(LNG CNT)
Resume Next
Else
Resume Exit _ Here
End If
Next
Case Else
InputBox Err。描述，“擦除未选择的”，错误。number
Resume Exit _ Here
End Select

End Sub
请看看代码，告诉我一些想法...

查看完整版本: 边界内的修剪和删除