http://screencast.com/t/4Cgvv5Tq
I work for a stainless steel manufacturing company where we use Inventor to model up our poducts, then export the sheetmetal parts using a flat pattern extracting tool which converts the flat patterns to a dxf file format that can be read by our CAM software. Right now we have to manually modify the dxf files to adjust the bend lines in order to be etched on the parts by our laser. I found a routine on the forum that I was able to use and modify to fit our needs to reduce this process to only a couple of steps. I would like to further modify the code to move the bend line to the center of the original line before it was modified. You would think that this would be an easy routine to write and it probably is to a more advanced coding gurus, however, I have very little experience writing VB code and no experience with VB in AutoCAD. I have spent about 8hrs trying to solve this problem to no avail. So if anyone can share some sample code that would point me in the right direction, I would greatly appreciate it. I have attached a link to a video that I created to show you what the code does right now and what I would like it to do.
Public Sub TrimBendLines()
'-------------------------------------------ADD MARK LAYER----------------------------------------------------
LayerName = "MARK"
Set MARK = ThisDrawing.Layers.Add(LayerName)
MARK.color = acRed
'---------------------------------------BEND UP LINES----------------------------------------------------
'Change the following line to match your layer names
Dim BendLineLayer As String: BendLineLayer = "IV_BEND"
'Change the following line to adjust how much line is left
Dim Remnant As Double: Remnant = 0.5
'Variable to hold PI for angle calculations
Const PI As Double = 3.14159265358979
'Need to declare a selection set in AutoCAD to store bend lines for trimming
Dim SelSet As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Add ("BendLines")
Set SelSet = ThisDrawing.SelectionSets.Item("BendLines")
SelSet.Clear
On Error GoTo 0
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
'Create filters so that we only select line objects on the bend line layer
FilterType(0) = 8: FilterData(0) = BendLineLayer
FilterType(1) = 0: FilterData(1) = "Line"
'Select the objects (if any exist)
SelSet.Select acSelectionSetAll, , , FilterType, FilterData
'If no bend lines are found then exit the sub routine
If SelSet.Count = 0 Then
GoTo BendDown
'Exit Sub
End If
'Set the active layer to the bend line layer for newly created lines
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(BendLineLayer)
'Enumerate the selection set and shorten the exiting bend line
'Next we create a new bend line existing at the endpoint.
Dim L As AcadLine
For Each L In SelSet
Dim EndPoint As Variant: EndPoint = L.EndPoint
L.EndPoint = ThisDrawing.Utility.PolarPoint(L.StartPoint, L.Angle, Remnant)
Call ThisDrawing.ModelSpace.AddLine(ThisDrawing.Utility.PolarPoint(EndPoint, L.Angle - PI, Remnant), EndPoint)
L.Layer = "MARK"
'L.TrueColor = acBlue
Next
'-------------------------------------------------CONVERT NEW LINES TO MARK LAYER ----------------------------------------
BendLineLayer = "IV_BEND"
On Error Resume Next
ThisDrawing.SelectionSets.Add ("BendLines")
Set SelSet = ThisDrawing.SelectionSets.Item("BendLines")
SelSet.Clear
On Error GoTo 0
'Create filters so that we only select line objects on the bend line layer
FilterType(0) = 8: FilterData(0) = BendLineLayer
FilterType(1) = 0: FilterData(1) = "Line"
'Select the objects (if any exist)
SelSet.Select acSelectionSetAll, , , FilterType, FilterData
'If no bend lines are found then exit the sub routine
If SelSet.Count = 0 Then
Exit Sub
End If
'Set the active layer to the bend line layer for newly created lines
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(BendLineLayer)
For Each L In SelSet
L.Layer = "MARK"
Next
'--------------------------------------------------------BEND DOWN LINES----------------------------------------
BendDown:
'Change the following line to match your layer names
BendLineLayer = "IV_BEND_DOWN"
'Need to declare a selection set in AutoCAD to store bend lines for trimming
On Error Resume Next
ThisDrawing.SelectionSets.Add ("BendLines")
Set SelSet = ThisDrawing.SelectionSets.Item("BendLines")
SelSet.Clear
On Error GoTo 0
'Create filters so that we only select line objects on the bend line layer
FilterType(0) = 8: FilterData(0) = BendLineLayer
FilterType(1) = 0: FilterData(1) = "Line"
'Select the objects (if any exist)
SelSet.Select acSelectionSetAll, , , FilterType, FilterData
'If no bend lines are found then exit the sub routine
If SelSet.Count = 0 Then
Exit Sub
End If
'Set the active layer to the bend line layer for newly created lines
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(BendLineLayer)
'Enumerate the selection set and shorten the exiting bend line
'Next we create a new bend line existing at the endpoint.
Dim x As Double
Dim y As Double
Dim MP(0 To 2) As Double
Dim EP(0 To 2) As Double
For Each L In SelSet
x = L.Delta(0) / 2
y = L.Delta(1) / 2
'EP(0) = L.EndPoint(0): EP(1) = L.EndPoint(1)
'MP(0) = L.Delta(0) / 2: MP(1) = L.Delta(1) / 2
L.EndPoint = ThisDrawing.Utility.PolarPoint(L.StartPoint, L.Angle, Remnant)
L.Layer = "MARK"
'L.EndPoint(0) = x: L.EndPoint(1) = y
'MP = L.Length / 2:
'L.Move EP, MP
'If L.StartPoint(0) = L.EndPoint(0) The
'LA = L.Angle
'EP(0) = L.EndPoint(0)
'SP(0) = L.StartPoint(0)
'LN = L.Length
'End If
Next
End Sub
