fjfhgdwfn 发表于 2006-5-25 15:24:00

[求助]多段线

一条多段线，如何等分。再在等分点上插入一个块

xinghesnak 发表于 2006-5-25 15:47:00

<P>看看这个帖子</P>
<P><A href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=11775" target="_blank" >http://bbs.mjtd.com/forum.php?mod=viewthread&tid=11775</A></P>

fjfhgdwfn 发表于 2006-5-25 16:29:00

<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CommandSTR <FONT color=blue>=</FONT> <FONT color=#880000>"<FONT color=red>(</FONT>Handent "</FONT> <FONT color=#880000>"" &amp; SsetObj.<FONT color=blue>Item</FONT><FONT color=red>(</FONT>i <FONT color=blue>-</FONT> 1<FONT color=red>)</FONT><FONT color=blue>.</FONT><FONT color=blue>Handle</FONT> &amp; "</FONT> <FONT color=#880000>""<FONT color=red>)</FONT>"</FONT><BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT color=blue>ThisDrawing</FONT>.<FONT color=blue>SendCommand</FONT> <FONT color=#880000>"MEASURE"</FONT> &amp; vbCr &amp; CommandSTR &amp; vbCr &amp; <FONT color=blue>CStr</FONT><FONT color=red>(</FONT>ds<FONT color=red>)</FONT> &amp; vbCr</P>
<P>&nbsp;在我这怎么用不了啊。</P>

fjfhgdwfn 发表于 2006-5-25 17:00:00

<P>&nbsp;Sub GetPointOfPline()<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Const ds As Double = 50&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '曲线上的取点间隔<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Const bb As String = "1"&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '块名<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim SsetObj As AcadSelectionSet&nbsp; '选择集对象<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim SsetPoint As AcadSelectionSet&nbsp; '点选择集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim SsetName As String&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '选择集名称<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim PointObj As AcadPoint&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '点对象<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim CommandSTR As String<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim Pt() As Double&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '点坐标<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim i As Integer, j As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim Num1 As Integer, Num2 As Integer</P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim gpCode(0) As Integer<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim dataValue(0) As Variant<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim groupCode As Variant, dataCode As Variant<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '选择集名称<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetName = "SplineSet"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '建立选择集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Add(SsetName)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetObj = ThisDrawing.SelectionSets.Item(SsetName)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Clear<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error GoTo 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将曲线添加到选择集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; gpCode(0) = 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dataValue(0) = "LWPOLYLINE"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; groupCode = gpCode<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dataCode = dataValue<BR>&nbsp;&nbsp;&nbsp;&nbsp; ' SsetObj.Select acSelectionSetAll, , , groupCode, dataCode<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.SelectOnScreen groupCode, dataCode<BR>&nbsp;&nbsp;&nbsp;&nbsp; ' MsgBox SsetObj.Count<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '打开文件用于存储曲线离散化后的点的坐标<BR>&nbsp;&nbsp;&nbsp;&nbsp; ' Open "D:\curve.txt" For Output As #1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Num1 = SsetObj.Count<BR>&nbsp;&nbsp;&nbsp;&nbsp; ' Print #1, "曲线数目：" &amp; Num1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '选择集名称<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetName = "PointSet"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '建立选择集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetPoint = ThisDrawing.SelectionSets.Add(SsetName)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Err Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set SsetPoint = ThisDrawing.SelectionSets.Item(SsetName)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetPoint.Clear<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Err.Clear<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; On Error GoTo 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将全部点添加到选择集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; gpCode(0) = 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dataValue(0) = "point"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; groupCode = gpCode<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dataCode = dataValue<BR>&nbsp;&nbsp;&nbsp;&nbsp; Dim blockRefObj As AcadBlockReference<BR>&nbsp;&nbsp;&nbsp;&nbsp; Dim insertionPnt(0 To 2) As Double<BR>&nbsp; </P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '在曲线上每隔一定距离取一个点，依次将点的坐标写入文件<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 1 To Num1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CommandSTR = "(Handent """ &amp; SsetObj.Item(i - 1).Handle &amp; """ ) "<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "MEASURE" &amp; vbCr &amp; CommandSTR &amp; vbCr &amp; CStr(ds) &amp; vbCr<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetPoint.Select acSelectionSetAll, , , groupCode, dataCode<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Num2 = SsetPoint.Count<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Num2 &lt;&gt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ReDim Pt(Num2 - 1, 2) As Double<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 0 To Num2 - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set PointObj = SsetPoint.Item(j)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Pt(j, 0) = PointObj.Coordinates(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Pt(j, 1) = PointObj.Coordinates(1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Pt(j, 2) = PointObj.Coordinates(2)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </P>
<P>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next j<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetPoint.Erase '删除选择集中所有图元<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'Print #1, "第" &amp; i &amp; "条曲线"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 0 To Num2 - 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ' Print #1, Format(Pt(j, 0), "0.000"); ""; Format(Pt(j, 1), "0.000"); ""; Format(Pt(j, 2), "0.000")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insertionPnt(0) = Pt(j, 0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insertionPnt(1) = Pt(j, 1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insertionPnt(2) = Pt(j, 2)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (insertionPnt, bb, 1#, 1#, 1#, 0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next j<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Close 1<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SsetObj.Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp; End Sub<BR>&nbsp; </P>
<P>实现多段线等距插入图块。</P>
页: [1]
查看完整版本: [求助]多段线