luofang683 发表于 2005-12-6 14:57:00

[VBA]如何在ＶＢＡ中画不同宽度的多线

请各位高手指点，如何在ＶＢＡ中画不同宽度的多线，盼复，谢谢！

王咣生 发表于 2005-12-6 21:11:00

reply

<P>帮助中的例子,SetWidth()方法:</P>
<P><BR>Sub Example_SetWidth()<BR>&nbsp;&nbsp;&nbsp; ' The following code prompts you to select a lightweight<BR>&nbsp;&nbsp;&nbsp; ' polyline, and then prompts you for the width to set each<BR>&nbsp;&nbsp;&nbsp; ' segment of the polyline.<BR>&nbsp;&nbsp;&nbsp; ' Pressing ENTER without specifying a width is equivalent to<BR>&nbsp;&nbsp;&nbsp; ' entering 0.<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim returnObj As AcadObject<BR>&nbsp;&nbsp;&nbsp; Dim basePnt As Variant<BR>&nbsp;&nbsp;&nbsp; Dim retCoord As Variant<BR>&nbsp;&nbsp;&nbsp; Dim StartWidth As Double<BR>&nbsp;&nbsp;&nbsp; Dim EndWidth As Double<BR>&nbsp;&nbsp;&nbsp; Dim i, j As Long<BR>&nbsp;&nbsp;&nbsp; Dim nbr_of_segments As Long<BR>&nbsp;&nbsp;&nbsp; Dim nbr_of_vertices As Long<BR>&nbsp;&nbsp;&nbsp; Dim segment As Long<BR>&nbsp;&nbsp;&nbsp; Dim promptStart As String<BR>&nbsp;&nbsp;&nbsp; Dim promptEnd As String<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select a polyline"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' Make sure the user selected a polyline.<BR>&nbsp;&nbsp;&nbsp; If Err &lt;&gt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If returnObj.EntityName &lt;&gt; "AcDbPolyline" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "You did not select a polyline"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' Obtain the coordinates of each vertex of the selected polyline.<BR>&nbsp;&nbsp;&nbsp; ' The coordinates are returned in an array of points.<BR>&nbsp;&nbsp;&nbsp; retCoord = returnObj.Coordinates<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; segment = 0<BR>&nbsp;&nbsp;&nbsp; i = LBound(retCoord)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Start index of coordinates array<BR>&nbsp;&nbsp;&nbsp; j = UBound(retCoord)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' End index of coordinates array<BR>&nbsp;&nbsp;&nbsp; nbr_of_vertices = ((j - i) \ 2) + 1&nbsp; ' Number of vertices in the polyline<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' Determine the number of segments in the polyline.<BR>&nbsp;&nbsp;&nbsp; ' A closed polyline has as many segments as it has vertices.<BR>&nbsp;&nbsp;&nbsp; ' An open polyline has one fewer segment than it has vertices.<BR>&nbsp;&nbsp;&nbsp; ' Check the Closed property to determine if the polyline is closed.<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; If returnObj.Closed Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; nbr_of_segments = nbr_of_vertices<BR>&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; nbr_of_segments = nbr_of_vertices - 1<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; ' Have user set the width for each segment of the polygon<BR>&nbsp;&nbsp;&nbsp; Do While nbr_of_segments &gt; 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Get width values from the user<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; promptStart = vbCrLf &amp; "Specify the width at the beginning of the segment at " &amp; retCoord(i) &amp; "," &amp; retCoord(i + 1) &amp; " ==&gt; "<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; promptEnd = vbCrLf &amp; "Now specify the width at the end of that segment ==&gt; "<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; StartWidth = ThisDrawing.Utility.GetReal(promptStart)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; EndWidth = ThisDrawing.Utility.GetReal(promptEnd)</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Set the width of the current segment<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; returnObj.SetWidth segment, StartWidth, EndWidth<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Prepare to obtain width of next segment, if any<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i = i + 2<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; segment = segment + 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; nbr_of_segments = nbr_of_segments - 1<BR>&nbsp;&nbsp;&nbsp; Loop<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; MsgBox "Segment widths have been set", , "SetWidth Example"</P>
<P>End Sub</P>
页: [1]
查看完整版本: [VBA]如何在ＶＢＡ中画不同宽度的多线