Results 1 to 5 of 5

Thread: Trimming a line using VBA

  1. #1
    Member
    Join Date
    2020-07
    Posts
    14
    Login to Give a bone
    0

    Default Trimming a line using VBA

    Hello Every one

    I want to trim a line using a Boundary line shown in the picture.
    here is my plan to do it..

    'get the boundary line
    .... okay
    'get the line to be trimmed.
    .... okay

    'get the intersection line
    .... okay

    'isolate(get) the portion of the entity after intersection
    .... how to do this???

    'delete the isolated entity
    .... okay

    1.PNG

  2. #2
    Member
    Join Date
    2020-07
    Posts
    14
    Login to Give a bone
    0

    Default Re: Trimming a line using VBA

    this link would be helpful to start with.
    https://forums.autodesk.com/t5/vba/trim/m-p/1582311

  3. #3
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    5,738
    Login to Give a bone
    0

    Default Re: Trimming a line using VBA

    Programs are dumb. You have to tell them exactly what to do. That is why the TRIM command works the way it does. It doesn't know what you want, so you have to pick the side to trim. I don't know what you want either. If you can't explain the criteria to be used to trim the unwanted portion, how can we help you? For example, I have a function that trims lines inside a block. I don't want lines to cross my block, so I can code the sub to trim any lines that cross the inside of the block. In your example shown, how would the program know one side from the other?
    C:> ED WORKING....

  4. #4
    Member
    Join Date
    2020-07
    Posts
    14
    Login to Give a bone
    0

    Default Re: Trimming a line using VBA

    Okay.
    I have a Road-way cross section shown in the picture. I want to trim a Line or Polyline that falls outside this fill slope line. The Line or Polyline is indicated by Magenta color on the picture. The fill slope lines are (2.0:1) and (1.5:1). So If possible how do I convert these lines to block or somehow remove the block property inside the function you have, and make it to trim what is outside the slope lines.

    Thank you.


    2.PNG
    Last edited by estuyose791044; 2020-10-18 at 06:09 AM.

  5. #5
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    5,738
    Login to Give a bone
    0

    Default Re: Trimming a line using VBA

    The problem is to come up with a set of conditions that are always true when "the outside" is selected. Looking at your sample, one condition is that the "outside" includes the ends of the line. Is that always going to be true? If so, you could submit the line to the IntersectWith method using the white lines. The intersection points nearest the StartPoint and EndPoint are the places to "trim". To "trim" a line, recreate it using new lines and erase the original or change the StartPoint and EndPoint. I'm attaching my code so you can see the various steps of how to compare and make decisions.
    Code:
    Public Sub BreakLineByBlock()
        'Break lines around block insertions.
         
        Dim str As String
        Dim strHandle As String
        Dim objLine As AcadLine
        Dim objLine1 As AcadLine
        Dim objLine2 As AcadLine
        Dim objSubEnt As AcadEntity
        Dim objBlock As AcadBlockReference
        Dim ssBlocks As AcadSelectionSet
        Dim ssLines As AcadSelectionSet
        Dim vSubEnts As Variant
        Dim vMinPoint As Variant
        Dim vMaxPoint As Variant
        Dim vIntPoint As Variant
        Dim vCPoint As Variant      'compare point
        Dim vSPoint As Variant      'start point
        Dim vSPoint1 As Variant     'start point prime
        Dim vEPoint As Variant      'end point
        Dim vEPoint1 As Variant     'end point prime
        Dim dPickPoint(0 To 1) As Double
        Dim dPoint(0 To 2) As Double
        Dim dDistSP As Double       'shortest distance from start point
        Dim dDistEP As Double       'shortest distance from end point
        Dim dDistC As Double        'comparison distance
        Dim dVertList(0 To 7) As Double
        Dim iL As Integer           'lines counter
        Dim iP As Integer           'points counter
        Dim iSE As Integer          'sub entities counter
        Dim iCntL As Integer        'line count
        Dim iCntP As Integer        'point count
        Dim iCntSE As Integer       'sub entity count
        Dim PtsInsideBB As Integer  '0=none: 1=StartPoint: 2=EndPoint
        Dim varFilterType(0) As Integer
        Dim varFilterData(0) As Variant
        Dim vFT As Variant
        Dim vFD As Variant
        Dim BBpoints(0 To 4) As Point   'Bounding box points list
        Dim Cpoint As Point         'compare point
    
        On Error GoTo Err_Control
        'Set up undo for this command
        ThisDrawing.StartUndoMark
        'get blocks
        ThisDrawing.Utility.Prompt "Lines will be broken around selected blocks."
        Set ssBlocks = toolbox.ejSelectionSets.GetSS_BlockFilter
        For Each objBlock In ssBlocks
            'Use the block's bounding box to select ents that intersect with it.
            objBlock.GetBoundingBox vMinPoint, vMaxPoint
            BBpoints(0).x = vMinPoint(0): BBpoints(0).y = vMinPoint(1)
            BBpoints(1).x = vMaxPoint(0): BBpoints(1).y = vMinPoint(1)
            BBpoints(2).x = vMaxPoint(0): BBpoints(2).y = vMaxPoint(1)
            BBpoints(3).x = vMinPoint(0): BBpoints(3).y = vMaxPoint(1)
            BBpoints(4).x = vMinPoint(0): BBpoints(4).y = vMinPoint(1)
            Set ssLines = toolbox.ejSelectionSets.AddSelectionSet("ssLines")
            ssLines.Clear
            varFilterType(0) = 0: varFilterData(0) = "LINE"
            vFT = varFilterType: vFD = varFilterData
            ssLines.Select acSelectionSetCrossing, vMaxPoint, vMinPoint, vFT, vFD
            'get subent's of block
            vSubEnts = objBlock.Explode
            iCntSE = UBound(vSubEnts)
            For Each objLine In ssLines
                'Compare subentity intersection points with line start and
                'end points to determine new line segment. Points creating the
                'shortest line segments should be the outer limits of the block.
                'Any other intersections are inside the block and are discarded.
                '  Get reference info.
                vSPoint = objLine.StartPoint
                vEPoint = objLine.EndPoint
                dDistSP = toolbox.ejMath.XYZDistance(vSPoint, vEPoint)
                dDistEP = toolbox.ejMath.XYZDistance(vEPoint, vSPoint)
                Cpoint.x = vSPoint(0): Cpoint.y = vSPoint(1)
                If toolbox.ejMath.InsidePolygon(BBpoints, Cpoint) = True Then PtsInsideBB = PtsInsideBB Or 1
                Cpoint.x = vEPoint(0): Cpoint.y = vEPoint(1)
                If toolbox.ejMath.InsidePolygon(BBpoints, Cpoint) = True Then PtsInsideBB = PtsInsideBB Or 2
                For iSE = 0 To iCntSE
                    'get list of points where the line intersects with the block
                    Set objSubEnt = vSubEnts(iSE)
                    vIntPoint = objSubEnt.IntersectWith(objLine, acExtendNone)
                    'Compare to line segment lengths.
                    If UBound(vIntPoint) > -1 Then
                        iCntP = (UBound(vIntPoint) + 1) / 3
                        For iP = 1 To iCntP
                            vCPoint = toolbox.ejMath.Point3D((vIntPoint(iP * 3 - 3)), (vIntPoint(iP * 3 - 2)), (vIntPoint(iP * 3 - 1)))
                            dDistC = toolbox.ejMath.XYZDistance(vSPoint, vCPoint)
                            If dDistC < dDistSP Then
                                dDistSP = dDistC
                                vSPoint1 = vCPoint
                            End If
                            dDistC = toolbox.ejMath.XYZDistance(vCPoint, vEPoint)
                            If dDistC < dDistEP Then
                                dDistEP = dDistC
                                vEPoint1 = vCPoint
                            End If
                        Next iP
                    Else
                        'the array returned by IntersectWith is dimensioned
                        ' (0 To -1) when there are no points.
                    End If
                Next iSE
                Select Case Round(objLine.Length, 14)
                    Case Is = Round(dDistSP, 14)
                        'line did not intersect the block
                        'do nothing
                    Case Is = Round(dDistSP + dDistEP, 14)
                        'One end of the line is inside the block and does
                        'not pass through, only one intersection point.
                        'Determine whether start point or end
                        'point is in the block and trim it. Assume the smaller
                        'distance is inside the block.
                        If dDistSP > dDistEP Then
                            'the endpoint is in the block
                            objLine.EndPoint = vEPoint1
                            objLine.Update
                        Else
                            'the startpoint is in the block
                            objLine.StartPoint = vSPoint1
                            objLine.Update
                        End If
                    Case Else
                        'enough intersection points exist to break the line
                        'create two new lines and delete the original
                        Select Case PtsInsideBB
                            Case Is = 0 'neither end is inside
                                If ThisDrawing.ActiveSpace = acModelSpace Then
                                    Set objLine1 = ThisDrawing.ModelSpace.AddLine(vSPoint, vSPoint1)
                                    Set objLine2 = ThisDrawing.ModelSpace.AddLine(vEPoint1, vEPoint)
                                Else
                                    Set objLine1 = ThisDrawing.PaperSpace.AddLine(vSPoint, vSPoint1)
                                    Set objLine2 = ThisDrawing.PaperSpace.AddLine(vEPoint1, vEPoint)
                                    'update new lines so that they will be seen by the next attempt to
                                    'get a selection set
                                End If
                                objLine1.Update
                                objLine2.Update
                                objLine.Delete
                            Case Is = 1 'start point is inside
                                objLine.StartPoint = vEPoint1
                                objLine.Update
                            Case Is = 2 'end point is inside
                                objLine.EndPoint = vSPoint1
                                objLine.Update
                            Case Is = 3 'both ends are inside
                        End Select
                        PtsInsideBB = 0 'reset for next line
                End Select
            Next objLine
            For iSE = 0 To iCntSE
                Set objSubEnt = vSubEnts(iSE)
                objSubEnt.Delete
            Next iSE
        Next objBlock
        
    Exit_Here:
        ThisDrawing.EndUndoMark
        Exit Sub
         
    Err_Control:
        Select Case Err.Number
        Case -2147352567
            If GetAsyncKeyState(VK_ESCAPE) And &H8000 > 0 Then
                Err.Clear
                Resume Exit_Here
            ElseIf GetAsyncKeyState(VK_LBUTTON) > 0 Then
                Err.Clear
                Resume
            End If
    '     Case -2145320928
    '       'User input is keyword or..
    '       'Right click
    '       Err.Clear
    '       Resume Exit_Here
        Case Else
            MsgBox Err.Description
            Resume Exit_Here
        End Select
    End Sub
    C:> ED WORKING....

Similar Threads

  1. Trim is not Trimming whole line...
    By robdg in forum CAD Management - General
    Replies: 2
    Last Post: 2008-06-03, 06:36 PM
  2. Replies: 5
    Last Post: 2007-04-13, 12:26 PM
  3. Improvement to Fillet & Chamfer trimming/no trimming options
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2006-07-12, 03:00 PM
  4. Fascia trimming @ gable end
    By christo4robin in forum Revit Architecture - General
    Replies: 4
    Last Post: 2006-03-22, 08:00 AM
  5. Trimming Facia Board
    By cccm1863 in forum Revit Architecture - General
    Replies: 8
    Last Post: 2004-01-05, 11:15 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •