在边界内修剪和删除

Matt__W · 发表于 2012-1-27 07:52:07

大家好；我是这个论坛的新手，这是我的第一篇帖子。希望我能从你们那里得到更好的回复。我的任务来了…
我只需要写一个VBA代码，它应该修剪穿过用户将选择的矩形边界的线/线。将删除边界外的所有其他对象或线/线，并修剪穿过边界的线；EXTRIM“；命令我需要通过VBA或LISP来完成。请帮助我
提前感谢

纵横五海 · 发表于 2012-1-27 08:24:09

在LSP中应该很容易做到（因为不支持VBA）
你已经有了EXTRIM，所以现在另一个缺失的部分是删除边界之外的所有内容&nbsp；很容易做到&nbsp；只需启动擦除命令，然后键入&#039；EXW（包括撇号）然后指定窗口的两个角（边界）和*poof！*边界之外的一切都被删除了。

迁安大地 · 发表于 2012-1-27 23:08:54

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

黑翼 · 发表于 2012-1-30 12:41:26

我有一些旧的代码，你可以看看，这是VBA。它删除所有未选定的实体
这应该给你一个起点

copy

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

为什么 · 发表于 2012-1-31 06:30:52

谢谢你的代码chuckhardin..让我用这个敲我的头，我&#039；我会回来的。。。

佣兵工会 · 发表于 2012-2-1 01:24:43

我尝试使用您的代码执行我的任务。但是需要选择不应删除的对象。所有其他对象都将被删除。这是我尝试的代码。这是绘图。SendCommand“_extrim“&amp；vbCr将完成wat的主要任务，我希望保持修剪和外部边界对象不变…我希望删除所有其他对象..我们的代码需要用户选择要保留的对象…任何其他建议都会有帮助…谢谢

笔畅资源库 · 发表于 2012-2-1 09:13:21

尽可能远离SendCommand语句
换句话说，您可以修改宏以采用边界框修剪所有实体，然后删除不在框中的实体。你可以用一个方框来选择。用户是否需要选择该框？是一个特殊层上的盒子，它不#039；上面没有其他物体吗&nbsp
对于erase，未选择公共子erase（varLL作为变量，varUR作为变量）
varLL是边界框的左下方
varUR是边界框右上方
，然后修改objSelSet。选择屏幕上的以使用对象集。选择acSelectionSetCrossing、varLL、varUR。此方法支持过滤机制
以下选择模式可用：窗口选择角点由点1和点2定义的矩形区域内的所有对象。交叉选择角点为点1和2的矩形区域内部和交叉的对象。上一个选择最近的选择集。如果在图纸空间和模型空间之间切换并尝试使用选择集，则忽略此模式
最后一个选择最近创建的可见对象
全部选择所有对象

左手╰→ · 发表于 2012-2-2 00:22:14

但是我需要修剪穿过多边形的线，EXTRIM会做得很好。所以我必须使用它。Lemme post wat我到目前为止已经完成了。它几乎完成了我想要的任务。但是EXTRIM命令的侧面是随机的。有时它会修剪和删除内部的线；the；边界..我总是希望修剪边界之外..欢迎宏的任何修改id，Dim Polygnline As AcadLWPolyline，Polygoncords As Variant，Dim lwpline As acadllwpolylines，varUR As variance；On Error GoTo Err\u Control（出错时转到Err\u控件）KillSSet（未选择）
；设置objSelSet=ThisDrawing。PickfirstSelectionSet；Set objUnSelectedSet=ThisDrawing.SelectionSets.Add（&quot；Unselected&quot；）

；对象集。在屏幕上选择'对象集。选择acSelectionSetCrossing、varLL、varUR
；objUnSelectedSet。选择acSelectionSetAll
；将对象（0到对象集计数-1）重新定义为身份
；对于lngCnt=0到objSelSet。计数-1&nbsp&nbsp
&nbsp&nbsp；Set objEnts（lngCnt）=objSelSet（lngcint）
&nbsp&nbsp；设置新对象（lngCnt）&nbsp&nbsp；设置polygnline=new\ent&nbsp&nbsp；新建。GetBoundingBox Pt3、Pt1&nbsp&nbsp；此图纸。SendCommand“_extrim“&amp；vbCr&amp；Pt1（0）&amp&quot&引用&amp；Pt1（1）和；vbCr&amp；Pt3（0）&amp&quot&引用&amp；Pt3（1）&amp；vbCr&nbsp&nbsp&nbsp
；下一个lngCnt

；objUnSelectedSet。删除不需要的项目；objUnSelectedSet。擦除；对象集。删除；objUnSelectedSet。删除
退出此处：；退出Sub
错误控制：；选择Case Err。数字&nbsp&nbsp；案例-2145320851&nbsp&nbsp&nbsp&nbsp&nbsp；对于lngCnt=0，请转至ThisDrawing.SelectionSets。计数-1；unt-1&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果此绘图。选择集。项目（lngCnt）。名称=“”；未选定“；然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；Set objUnSelectedSet=ThisDrawing.SelectionSets。项目（lngCnt）&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；继续下一步&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；其他&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；在此处继续退出&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp；下一步&nbsp&nbsp；案例Else&nbsp&nbsp&nbsp&nbsp&nbsp；输入框错误。“说明”；删除未选中的“；，犯错误数字&nbsp&nbsp&nbsp&nbsp&nbsp；在此处继续退出；结束选择
请看一下代码并告诉我任何想法。。。

在边界内修剪和删除

发表回复

精选推荐