求助直线加长的问题

xgngg

我想让图中的某些直线长度加长，当我编不来VBA，请高手帮忙一下，帮我编一个，谢谢了



附件中A是原来的，B是运行VBA后的

xgngg

zhang007

Sub n()
On Error Resume Next
Dim sset As AcadSelectionSet
Dim entry As AcadLine
Dim insertpoint As Variant
Dim insertpoint1 As Variant
Set sset = ThisDrawing.ModelSpace.SelectionSets.Add("ss1")
If Err Then
Err.Clear
ThisDrawing.SelectionSets("ss1").Delete
Set sset = ThisDrawing.SelectionSets.Add("ss1")
End If
sset.SelectOnScreen
For Each entry In sset
insertpoint = entry.StartPoint
insertpoint1 = entry.EndPoint
If insertpoint(1) > insertpoint1(1) Then
insertpoint(1) = insertpoint(1) + 100
insertpoint1(1) = insertpoint1(1) - 100
entry.StartPoint = insertpoint
entry.EndPoint = insertpoint1
Else
insertpoint(1) = insertpoint(1) - 100
insertpoint1(1) = insertpoint1(1) + 100
entry.StartPoint = insertpoint
entry.EndPoint = insertpoint1
End If
Next entry
End Sub