关于PolyLine对象的线型和颜色的问题请教

wmz

1.   

复制代码

以下代码唯一没有实现的就是PolyLine对象的线型和颜色随设置而改变，绘出的图形均是实线和一种颜色，X11是虚线，   查线型是X11，但不显示虚线。请高手支招！

  Dim Newlayer As AcadLayer
   Dim ltobj As AcadLineType
   Dim Newlayer1 As AcadLayer
   Dim ltobj1 As AcadLineType
   Dim I1 As Integer, J1 As Integer, L1 As Integer, XY() As Double, SW As Single, DataType(1) As Integer, xDATA(1) As Variant
   Set ltobj = ThisDrawing.Linetypes.Add("CONTINUOUS")
          ThisDrawing.ActiveLinetype = ltobj
   Set Newlayer = ThisDrawing.Layers("DGX")
          ThisDrawing.ActiveLayer = Newlayer
   Set ltobj1 = ThisDrawing.Linetypes.Add("X13")
          ThisDrawing.ActiveLinetype = ltobj1
   Set Newlayer1 = ThisDrawing.Layers("DSX")
          ThisDrawing.ActiveLayer = Newlayer1
         DataType(0) = 1001: xDATA(0) = "SOUTH"
         DataType(1) = 1000
       If k1 > 1 Then
            I1 = -3: J1 = -2: L1 = -1
          For j = 1 To k1
            I1 = I1 + 3: J1 = J1 + 3: L1 = L1 + 3
           ReDim Preserve XY(L1)
            XY(I1) = Y1(j): XY(J1) = X1(j): XY(L1) = DGX(i)
          Next j
           Set pLObj = ThisDrawing.ModelSpace.AddPolyline(XY)
               pLObj.Elevation = DGX(i)
              If BH(i, LL) = 1 Then
                 pLObj.Closed = True
              End If
              If k1 > 2 Then
                 pLObj.Type = acQuadSplinePoly
              End If
           If DGX(i) >= SW Then
                pLObj.Layer = "DGX"
                pLObj.Linetype = "CONTINUOUS"
             If DGX(i) Mod 5 = 0 Then
                pLObj.ConstantWidth = 0.3
                pLObj.TrueColor.ColorIndex = acBlue
                xDATA(1) = "201102"
                pLObj.SetXData DataType, xDATA
             Else
                pLObj.ConstantWidth = 0.15
                pLObj.TrueColor.ColorIndex = acYellow
                xDATA(1) = "201101"
                pLObj.SetXData DataType, xDATA
             End If
           ElseIf DGX(i) < SW Then
              pLObj.Layer = "DSX"
                pLObj.Linetype = "X13"
             If DGX(i) Mod 5 = 0 Then
                pLObj.ConstantWidth = 0.3
                pLObj.TrueColor.ColorIndex = acBlue
                xDATA(1) = "186302"
                pLObj.SetXData DataType, xDATA
             Else
                pLObj.ConstantWidth = 0.15
                pLObj.TrueColor.ColorIndex = acYellow
                xDATA(1) = "186301"
                pLObj.SetXData DataType, xDATA
             End If
           End If
              pLObj.Update

         End If

zzyong00

1. Dim x As New AcadAcCmColor
   
2. x.ColorIndex = acBlue
   
3. pLObj.TrueColor = x

Dim x As New AcadAcCmColor<br /> x.ColorIndex = acBlue<br /> pLObj.TrueColor = x

颜色，这么改

zzyong00

线形问题，可能是线形比例和全局线形比例的问题

wmz

zzyong00 发表于 2014-10-21 22:59
线形问题，可能是线形比例和全局线形比例的问题

非常感谢你的帮助，颜色搞好了，原来还要转这么大一个弯，费劲！那个线型还是弄不好。

wmz

线型已经解决！