dose anyone know of a vba trim

this is realy just a general question,

dose anyone know of a vba trim routine (im writing one and i just want to
know if its been done or not)

Navi

 

There's no TRIM capability in VBA or ActiveX. You can write your
own, which while not too hard for things like lines and arcs, is
not something I'd savor doing if the goal is to fully support all
entity types supported by the TRIM command (e.g., splines, ellipses
and polylines).

One of the lesser-understood concepts of trimming and breaking an
object, is object identity. What may not be obvious from the user's
perpspective, is that trimming an object like a CIRCLE, causes that
entity to be changed to an ARC (e.g., the resulting ARC has the same
handle, object id, and extended data as the original CIRCLE). Making
that happen is not possible in VBA or ActiveX, and can only be done
using ObjectARX.

If you're using and are limited to AutoCAD 2005, there is also the
Managed .NET Wrappers for ObjectARX, which makes it somewhat easier,
but requires fairly in-depth familiarity with ObjectARX classes.

<sales pitch>

For any release of AutoCAD, the AcadX ActiveX Extension library
offers a Curve class that includes methods like Divide, Measure,
and Break, the latter of which can be used to relatively easily
TRIM any object that can be trimmed by the AutoCAD TRIM command.

AcadX also has methods that allow you to exchange the identities
of two objects (as per the CIRCLE->ARC example discussed above),
so that you can emulate that aspect of the AutoCAD TRIM command
as well, which is very important if your objects are referenced
by other objects or external data, or if your objects have any
kind of application data (xdata or xdictionary based) associated
with them. Since AutoCAD itself routinely references objects for
things like draworder, this aspect of operations that involve
replacing one object with another, becomes much more important to
those who are serious about robust AutoCAD development.

Visit www.caddzone.com/acadx for more info.

</sales pitch>

 

Are you wanting user interaction or just to automatically trim some lines. I
have done one that trims lines outside of an enclosed defined area but it
was complicated. I had to create offsets from the original area and then
define all of the intersections so I could pick the lines to trim. What
direction are you going in?

 

well thanks to autocads wonderful uninstall program all the code I had done
was trashed (deleted)
but the method I am using is to define a region object then take that
region's bounding box to select all the objects that cross it. then I find
all the intersection points for each entity and edit the entities separately
doing lines is easy what imp having issues with is arcs. I had something
that would work properly if the arc length was less than 180 degrees but now
its gone.

I could really use some help in rebuilding

 

Are you sure they were deleted? Did you search the drive for *.dvb? I seriously doubt the uninstall prog deleted them. It only know about files it installed. Even if you stored them in a folder under acad, the folder would not have been deleted. For example, an uninstall usually leaves the Support folder if the user had put any custom menus there.

--
----
Ed
----
well thanks to autocads wonderful uninstall program all the code I had done
was trashed (deleted)
but the method I am using is to define a region object then take that
region's bounding box to select all the objects that cross it. then I find
all the intersection points for each entity and edit the entities separately
doing lines is easy what imp having issues with is arcs. I had something
that would work properly if the arc length was less than 180 degrees but now
its gone.

I could really use some help in rebuilding

 

For what its worth, here is how I'm trimming arcs in something that
either trims or breaks:

' Breakarc
Private Sub BreakArc(arc As AcadArc)
Dim pt1 As Variant
Dim pt2 As Variant
Dim Response As Variant
Dim Arc1 As AcadArc, Arc2 As AcadArc, Arc3 As AcadArc
Dim pt1a As Double
Dim pt2a As Double
Dim TempPt As Variant
Dim ASA As Double
Dim AEA As Double
Const PI = 3.14159265359
Dim Check As Boolean
Dim GapAng As Double ' angle to achieve break gap if desired
Dim ActSpace As AcadObject
Select Case ThisDrawing.ActiveSpace
Case acModelSpace
Set ActSpace = ThisDrawing.ModelSpace
Case acPaperSpace
Set ActSpace = ThisDrawing.PaperSpace
End Select
If ufBreak2Hidden.cboxGap Then
GapAng = GapDist / arc.Radius
End If
Do
Dim strPrmt As String
If Not (IntMode) Then
strPrmt = "Select first point on the arc :"
Else
strPrmt = "Select intersection breakpoint on the arc :"
End If
pt1 = ThisDrawing.GetPoint(, vbCr & strPrmt)
Check = IsPointOnArc(pt1, arc, pt1a)
If Not (Check) Then
Response = MsgBox("The Point You Selected Does NOT Fall On
The Arc. Try Again?", _
vbYesNo, "Invalid Point Selection.")
If Response = vbNo Then
GoTo UserCAN
End If
End If
Loop While Not (Check)
Do
If Not (IntMode) Then
pt2 = ThisDrawing.GetPoint(, vbCr & "Select Second Point :")
Check = IsPointOnArc(pt2, arc, pt2a)
If Not (Check) Then
Response = MsgBox("The Point You Selected Does NOT Fall On
The Arc. Try Again?", _
vbYesNo, "Invalid Point Selection.")
If Response = vbNo Then
GoTo UserCAN
End If
End If
Else
Check = IsPointOnArc(pt1, arc, pt2a) ' arc equiv pt2=pt1
End If
Loop While Not (Check)
ThisDrawing.StartUndoMark
IncUndo
' pts are on the arc at this point
ASA = arc.StartAngle
AEA = arc.EndAngle
If AEA < ASA Then AEA = AEA + 2 * PI ' correct AEA if past xaxis
' conform order so that pt1 is closest to arc start
' this reduces the number of cases to four
If (pt1a - ASA) < (pt2a - ASA) Then
'don't swap
Else ' swap point angles (points not needed anymore)
TempPt = pt1a
pt1a = pt2a
pt2a = TempPt
End If
Select Case ArcCaseType(ASA, AEA, pt1a, pt2a)
Case 1 ' points are within, arc breaks into three lines
Set Arc1 = ActSpace.AddArc(arc.Center, arc.Radius, ASA,
pt1a - GapAng)
MatchEntSymb Arc1, arc
Set Arc2 = ActSpace.AddArc(arc.Center, arc.Radius, pt2a +
GapAng, AEA)
MatchEntSymb Arc2, arc
Case 2 ' pt1 = S, line breaks into two arcs, tail remains
Set Arc2 = ActSpace.AddArc(arc.Center, arc.Radius, pt2a +
GapAng, AEA)
MatchEntSymb Arc2, arc
Case 3 ' pt2 = E, line breaks into two arcs, head remains
Set Arc1 = ActSpace.AddArc(arc.Center, arc.Radius, ASA,
pt1a - GapAng)
MatchEntSymb Arc1, arc
Case 4 ' pt1= S, pt2= E, whole arc is replaced
' this is common to all cases
End Select
' brkline is the same for all cases
If Not (Me.cboxDelBrk) Then ' if trim don't make
Set Arc3 = ActSpace.AddArc(arc.Center, arc.Radius, pt1a +
GapAng, pt2a - GapAng)
MakeEntHidSymb Arc3
End If
arc.Delete
Set ActSpace = Nothing
ThisDrawing.EndUndoMark
Exit Sub
UserCAN:
On Error GoTo 0
arc.Highlight (False)
Set ActSpace = Nothing
ThisDrawing.EndUndoMark
End Sub



' returns true if pt is on arc, aslo returns a conformed point angle
value
' with respect to arc.
Function IsPointOnArc(pt As Variant, arc As AcadArc, ptA As Double) As
Boolean
Dim ASA As Double
Dim AEA As Double
Const PI = 3.14159265359
On Error GoTo Badpoint ' handles case where one right clicks
If Abs(Dist(pt, arc.Center) - arc.Radius) > Res Then Exit Function
'not on arc for sure
' establish arc character
ASA = arc.StartAngle
AEA = arc.EndAngle
If AEA < ASA Then AEA = AEA + 2 * PI ' correct AEA if past
xaxis
ptA = ThisDrawing.Utility.AngleFromXAxis(arc.Center, pt)
If ptA >= ASA And ptA <= AEA Then ' for sure on arc
IsPointOnArc = True
Else ' maybe still on arc
If ptA < ASA And 2 * PI + ptA <= AEA Then ' on arc
ptA = 2 * PI + ptA
IsPointOnArc = True ' note: this also means pt is beyond
2PI
End If
End If
Exit Function
Badpoint:
IsPointOnArc = False
End Function

' returns arc break case type 1,2,3, or 4
' ASA and AEA are the arc start and end angles, pt1a and pt2a are the
break pick angles
' type 1 - pt1 and pt2 are within the arc S to E
' type 2 - pt2 is within the line S to E, but pt1 = arc start
' type 3 - pt1 is within the line S to E, but pt2 = arc end
' type 4 - pt1 and pt2 are also S to E
Function ArcCaseType(ASA As Double, AEA As Double, pt1a As Double,
pt2a As Double) As Integer
If ASA = pt1a Then 'either 2 or 4
If AEA = pt2a Then
ArcCaseType = 4
Else
ArcCaseType = 2
End If
Else ' either 1 or 3
If AEA = pt2a Then
ArcCaseType = 3
Else
ArcCaseType = 1
End If
End If
End Function