xgngg 发表于 2004-12-2 18:18:00

求助直线加长的问题

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



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

xgngg 发表于 2004-12-2 18:20:00

zhang007 发表于 2004-12-2 21:22:00

Sub n()


<BR>On Error Resume Next<BR>Dim sset As AcadSelectionSet<BR>Dim entry As AcadLine<BR>Dim insertpoint As Variant<BR>Dim insertpoint1 As Variant<BR>Set sset = ThisDrawing.ModelSpace.SelectionSets.Add("ss1")<BR>If Err Then<BR>Err.Clear<BR>ThisDrawing.SelectionSets("ss1").Delete<BR>Set sset = ThisDrawing.SelectionSets.Add("ss1")<BR>End If<BR>sset.SelectOnScreen<BR>For Each entry In sset<BR>                                                       insertpoint = entry.StartPoint<BR>                                                       insertpoint1 = entry.EndPoint<BR>                                                       If insertpoint(1) &gt; insertpoint1(1) Then<BR>                                                       insertpoint(1) = insertpoint(1) + 100<BR>                                                       insertpoint1(1) = insertpoint1(1) - 100<BR>                                                       entry.StartPoint = insertpoint<BR>                                                       entry.EndPoint = insertpoint1<BR>                                                       Else<BR>                                                       insertpoint(1) = insertpoint(1) - 100<BR>                                                       insertpoint1(1) = insertpoint1(1) + 100<BR>                                                       entry.StartPoint = insertpoint<BR>                                                       entry.EndPoint = insertpoint1<BR>                                                       End If<BR>                                                       Next entry<BR>End Sub<BR>
页: [1]
查看完整版本: 求助直线加长的问题