Author Topic: Trimming and deleting within a boundary  (Read 8383 times)

0 Members and 1 Guest are viewing this topic.

sundar

  • Guest
Trimming and deleting within a boundary
« on: January 27, 2012, 07:52:07 AM »
Hi All,

  Im new to this forum and this is my first Post..Hope i will get better replies from you all..here goes my task...
I just need to write a VBA code which should trim the lines/Plines which are crossing a rectangular boundary that will be selected by the user.All other objects or Lines/Pline outside the boundary is to be deleted and lines crossing it is to be trimmed off.Exactly as "EXTRIM" command.I need to do it through VBA or LISP..Please Help me Out.....  :-D

Thanks in Advance............

Matt__W

  • Seagull
  • Posts: 12954
  • I like my water diluted.
Re: Trimming and deleting within a boundary
« Reply #1 on: January 27, 2012, 08:24:09 AM »
Should be pretty easy to do in LSP (since VBA is unsupported).

You already have EXTRIM so now the other missing piece is erasing everything outside the boundary.  Easy enough to do.  Just start the ERASE command then type 'EXW (including the apostrophe) then specify the two corners of a window (your boundary) and *poof!* everything outside the boundary is erased.
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

sundar

  • Guest
Re: Trimming and deleting within a boundary
« Reply #2 on: January 27, 2012, 11:08:54 PM »
Thanks a lot..Could you pls provide the LISP code..im not much aware of LISP..workin in VBA oly.. so............. thanks.... :)

ChuckHardin

  • Guest
Re: Trimming and deleting within a boundary
« Reply #3 on: January 30, 2012, 12:41:26 PM »
I have some old code you can look at that is VBA. It deletes all entities that are not selected.
This should give you a starting point.

Code: [Select]
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

  • Guest
Re: Trimming and deleting within a boundary
« Reply #4 on: January 31, 2012, 06:30:52 AM »
Thanks for your code chuckhardin..Lemme bang my head with this and i'll get back... :)

sundar

  • Guest
Re: Trimming and deleting within a boundary
« Reply #5 on: February 01, 2012, 01:24:43 AM »
I tried using your code for the task i have..but the objects needs to be selected which should not be deleted..all others will be deleted..here is wat i tried..

ThisDrawing.SendCommand "_extrim" & vbCr

this wil do the main task of wat i wanted leaving trimmed and the outer boundary objects as it is...i want t delete all others..ur code need users t select the objects to keep...any more suggestion would be helpful...Thanks..



ChuckHardin

  • Guest
Re: Trimming and deleting within a boundary
« Reply #6 on: February 01, 2012, 09:13:21 AM »
Stay away from the SendCommand statement as much as possible.
In other words you can modify the macro to take a bounding box trim all entities then delete the entities that are not in the box. You could use a a box for the selection. Does the user need to select the box? Is the box on a special layer that doesn't have any other objects on it? 

for the erase
Public Sub EraseUnselected(varLL as variant, varUR as variant)
varLL is the Lower Left of the bounding box
varUR is the Upper Right of the bounding box

then modify objSelSet.SelectOnScreen
to use objSelSet.Select acSelectionSetCrossing, varLL, varUR

This method supports the filtering mechanism.
The following selection modes are available:

Window
Selects all objects completely inside a rectangular area whose corners are defined by Point1 and Point2.

Crossing
Selects objects within and crossing a rectangular area whose corners are defined by Point1 and Point2.

Previous
Selects the most recent selection set. This mode is ignored if you switch between paper space and model space and attempt to use the selection set.

Last
Selects the most recently created visible objects.

All
Selects all objects.


sundar

  • Guest
Re: Trimming and deleting within a boundary
« Reply #7 on: February 02, 2012, 12:22:14 AM »
But i need to trim off the lines crossing the polygon which EXTRIM would do greatly..So i have to use it..Lemme post wat i have done so far..it almost does the task i want..but the sided of EXTRIM command is randomly taken..at times it trims and deletes lines inside  the  boundary..i always want t trim outside of the boundary..any modification id the macro is welcome.. :)

Public Sub EraseUnselected()
Dim objSelSet As AcadSelectionSet
Dim objUnSelectedSet As AcadSelectionSet
Dim objEnts() As AcadEntity
Dim lngCnt As Long, Coords As Variant, new_ent As AcadEntity
Dim Pt3 As Variant, Pt1 As Variant, Unwanted_ent As AcadEntity
Dim PolygnPline As AcadLWPolyline, PolygonCoords As Variant
Dim lwpline As AcadLWPolyline
Dim varLL As Variant, varUR As Variant
'On Error GoTo Err_Control
KillSSet ("Unselected")
 Set objSelSet = ThisDrawing.PickfirstSelectionSet
 Set objUnSelectedSet = ThisDrawing.SelectionSets.Add("Unselected")
 
 objSelSet.SelectOnScreen
 'objSelSet.Select acSelectionSetCrossing, varLL, varUR
 
 objUnSelectedSet.Select acSelectionSetAll
 
 ReDim objEnts(0 To objSelSet.Count - 1) As AcadEntity
 
 For lngCnt = 0 To objSelSet.Count - 1
     
      Set objEnts(lngCnt) = objSelSet(lngCnt)
      Set new_ent = objEnts(lngCnt)
      Set PolygnPline = new_ent
      new_ent.GetBoundingBox Pt3, Pt1
      ThisDrawing.SendCommand "_extrim" & vbCr & Pt1(0) & "," & Pt1(1) & vbCr & Pt3(0) & "," & Pt3(1) & vbCr
       
 Next lngCnt
 

 
 objUnSelectedSet.RemoveItems Unwanted_ent
 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


Please have a look at the code and tel me any ideas ... :)