i've got a code from this group (Design, Minkwitz,Jul/27/00 - 14:46 ) to trim, my problem is that you have to select the obj on screen, I would like to let it run with a array so you don't have to select anything, any suggestions??Cause this isn't working...
Public Sub Trim()
Dim objEnt As AcadEntity
Dim objCut As AcadArc
Dim objTrim As AcadLine
Dim varPnt(0 To 2) As Double
Dim varSPnt As Variant
Dim varEPnt As Variant
Dim strPrmpt As String
Dim varTrimPnt As Variant
Dim dblTrimPnt(2) As Double
Dim varInterSectns As Variant
Dim GetLength
On Error GoTo Err_Control
'Line to cut to
varPnt(0) = 0
varPnt(1) = 0
varPnt(2) = 0
ThisDrawing.Utility.GetEntity objCut, Array(varPnt(0), varPnt(1), varPnt(2))
Do
'line to trim
ThisDrawing.Utility.GetEntity objEnt, varPnt, strPrmpt
'trimming
If TypeOf objEnt Is AcadLine Then
Set objTrim = objEnt
varInterSectns = objTrim.IntersectWith(objCut, acExtendNone)
If IsArray(varInterSectns) Then
If UBound(varInterSectns) > 0 Then
varSPnt = objTrim.StartPoint
varEPnt = objTrim.EndPoint
dblTrimPnt(0) = varInterSectns(0)
dblTrimPnt(1) = varInterSectns(1)
dblTrimPnt(2) = varInterSectns(2)
varTrimPnt = Array(varInterSectns(0), varInterSectns(1), varInterSectns(2))
' objTrim.startPoint = dblTrimPnt
objTrim.EndPoint = dblTrimPnt
End If
End If
End If
Loop
Exit_here:
If Not objCut Is Nothing Then
objCut.Highlight False
End If
Exit Sub
Err_Control:
'If they select anything other than A line
If Err.Description = "Type mismatch" Then
Err.Clear
End If
End Sub