CLONESOME 发表于 2006-9-13 11:34:00

[函数]

<P>作了一个改多线段方向的函数,请高手指正:</P>
<P>Public Sub qq()<BR>Dim pt() As Double<BR>Dim a As Double<BR>Dim obj As AcadLWPolyline<BR>Dim objj As AcadLWPolyline</P>
<P>On Error Resume Next<BR>Dim sset As AcadSelectionSet<BR>If Not IsNull(ThisDrawing.SelectionSets.Item("example")) Then<BR>Set sset = ThisDrawing.SelectionSets.Item("example")<BR>sset.Delete<BR>End If</P>
<P>Set sset = ThisDrawing.SelectionSets.Add("example")<BR>sset.SelectOnScreen<BR>Dim element As AcadEntity</P>
<P>For Each element In sset</P>
<P>Set obj = sset.Item(0)</P>
<P>Next</P>
<P>pt = obj.Coordinates</P>
<P>For i = 0 To (UBound(pt) - 1) / 2<BR>a = pt(i)<BR>pt(i) = pt(UBound(pt) - i)<BR>pt(UBound(pt) - i) = a<BR>Next</P>
<P>For i = 1 To UBound(pt) Step 2<BR>a = pt(i)<BR>pt(i) = pt(i - 1)<BR>pt(i - 1) = a<BR>Next</P>
<P>Set objj = ThisDrawing.ModelSpace.AddLightWeightPolyline(pt)<BR>If obj.Closed = True Then<BR>objj.Closed = True<BR>End If<BR>objj.Linetype = obj.Linetype<BR>objj.LinetypeGeneration = obj.LinetypeGeneration<BR>objj.LinetypeScale = obj.LinetypeScale<BR>objj.Lineweight = obj.Lineweight<BR>objj.TrueColor = obj.TrueColor<BR>objj.Layer = obj.Layer<BR>obj.Delete<BR>End Sub<BR></P>
页: [1]
查看完整版本: [函数]