Sub tt()
'本程序的作用是选择一个pline线。然后用mline线重新绘制(原pline保留)
'mline 对正样式是“无”都设置好了,直接调用即可
Dim px(200) As Double '处理N个点(不定) Dim py(200) As Double 'Dim center(211) As Double Dim ent As Object ' let the user select a block. ' If (flgPickNested = True) Then Debug.Print "错误" Exit Sub Else Dim pt As Variant ThisDrawing.Utility.GetEntity ent, pt End If
var = ent.Coordinates retCoord = ent.Coordinates k = (UBound(retCoord) + 1) / 2 '记录pline顶点个数
For i = 0 To UBound(retCoord) Step 2 px(i / 2) = retCoord(i) py(i / 2) = retCoord(i)
Next i ReDim center(2 * (k - 1) + 1) As Double
For i = 0 To k - 1 center(i) = px(i) center(i + 1) = py(i) 'center(i + 2) = 0 MsgBox center(i) & " =" & center(i + 1) Next i Dim lll As AcadMLine
Set lll = ThisDrawing.ModelSpace.AddMLine(center) ZoomAll