'***************************************************
'名称：LWPolylineTo2DPolyline
'作者：罗简单
'日期：2008-7-26
'功能：实现多段线转二维多段线
'目的：在为界址线赋值前，先要将宗地线转为二维多段线
'***************************************************
Public Sub LWPolylineTo2DPolyline()
  '建立过滤参数
  Dim pType As Variant, pData As Variant
  BuildFilter pType, pData, 0, "LWPOLYLINE"
 
  '建立选择集
  Dim sset As AcadSelectionSet
  Set sset = CreateSelectionSet
 
  sset.Select acSelectionSetAll, , , pType, pData
  Dim lwpObj As AcadLWPolyline
  Dim gType, gData
  '循环选择集
  For Each lwpObj In sset
    '获取扩展属性
    lwpObj.GetXData "SOUTH", gType, gData
   
    If VarType(gType) = vbEmpty Then GoTo Do_Next
    Select Case gData(1)
      Case "300000"
        Call LwpTo2DPL(lwpObj)
      Case Else
        GoTo Do_Next
    End Select
Do_Next:
  Next lwpObj
End Sub

'******************************************************
'名称：LwpTo2DPL
'作者：罗简单
'日期：2008-7-26
'功能：将单个多段线转换为二维多段线
'******************************************************
Public Sub LwpTo2DPL(pLwp As AcadLWPolyline)
  ThisDrawing.SendCommand "ConvertPoly H "
 
  Dim strCmd As String
  strCmd = "(Handent""" & pLwp.Handle & """)"
 
  ThisDrawing.SendCommand strCmd & " "
  ThisDrawing.SendCommand " "
End Sub