VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 
Reply
Message 1 of 1
Sylvester
174 Views, 0 Replies

Trim

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
0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost