如何将选择的pline用mline重绘

chman

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

End Sub 程序始终出错 请各位大虾帮忙调试

alin

Sub tt() '±¾³ÌÐòµÄ×÷ÓÃÊÇÑ¡ÔñÒ»¸öplineÏß¡£È»ºóÓÃmlineÏßÖØлæÖÆ£¨Ô­pline±£Áô£© 'mline ¶ÔÕýÑùʽÊÇ¡°ÎÞ¡±¶¼ÉèÖúÃÁË£¬Ö±½Óµ÷Óü´¿É Dim px() As Double '´¦ÀíN¸öµã£¨²»¶¨£©
Dim py() As Double
Dim center() 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¶¥µã¸öÊý ReDim px(k)
ReDim py(k)
For i = 0 To UBound(retCoord) Step 2
px(i / 2) = retCoord(i)
py(i / 2) = retCoord(i + 1)
Next i
ReDim center(3 * k - 1)

For i = 0 To k - 1
center(3 * i) = px(i)
center(3 * i + 1) = py(i)
center(3 * i + 2) = 0#
MsgBox center(3 * i) & ", " & center(3 * i + 1) & ", " & center(3 * i + 2)
Next i
Dim lll As AcadMLine

Set lll = ThisDrawing.ModelSpace.AddMLine(center)
ZoomAll

End Sub

chman

对以上程序我做了一点改进 只要执行有误，那么就是在2，和3之间的事情 Sub tt() Do While 1
Dim ent As Object
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) / 3 '记录pline顶点个数
ReDim px(k - 1) As Double
ReDim py(k - 1) As Double For i = 0 To UBound(retCoord) Step 3
px(i / 3) = retCoord(i)
py(i / 3) = retCoord(i + 1) Next i
Dim m As Integer
Dim n As Integer
m = 0
n = 0
ReDim Center(3 * (k - 1) + 2) As Double
For i = 0 To k - 1 Center(i * 3) = px(i)
Center(i * 3 + 1) = py(i)
Center(i * 3 + 2) = 0
'MsgBox px(i) & "*" & py(i)
Next i


'For i = 0 To 2 * (k - 1) + 1
'MsgBox Center(i)
'Next i
Dim lwp As AcadMLine

Set lwp = ThisDrawing.ModelSpace.AddMLine(Center)

lwp.Update

picked = True

Loop

ErrHandle:

End Sub
新的问题又来了，我要在自动绘制前把mline的线间距调整一下。 如何用程序实现

alin

查查系统变量CMLJUST,CMLSCALE和CMLSTYLE