如何将选择的pline用mline重绘

chman 发表于 2005-4-2 17:11:00

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 发表于 2005-4-2 21:50:00

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 发表于 2005-4-2 23:43:00

对以上程序我做了一点改进

只要执行有误，那么就是在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 发表于 2005-4-3 08:06:00

查查系统变量CMLJUST,CMLSCALE和CMLSTYLE

页: [1]

明经CAD社区's Archiver

如何将选择的pline用mline重绘