Code Red > VB(A)

Trimming and deleting within a boundary

(1/2) > >>

sundar:
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............

M@yhem:
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.

sundar:
Thanks a lot..Could you pls provide the LISP code..im not much aware of LISP..workin in VBA oly.. so............. thanks.... :)

ChuckHardin:
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: ---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

--- End code ---

sundar:
Thanks for your code chuckhardin..Lemme bang my head with this and i'll get back... :)

Navigation

[0] Message Index

[#] Next page