wmz 发表于 2014-10-21 19:30:31

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

本帖最后由 wmz 于 2014-10-21 19:35 编辑

以下代码唯一没有实现的就是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 发表于 2014-10-21 22:52:03

Dim x As New AcadAcCmColor
x.ColorIndex = acBlue
pLObj.TrueColor = x
颜色，这么改

zzyong00 发表于 2014-10-21 22:59:15

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

wmz 发表于 2014-10-22 13:58:45

zzyong00 发表于 2014-10-21 22:59 static/image/common/back.gif
线形问题，可能是线形比例和全局线形比例的问题

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

wmz 发表于 2014-10-26 14:53:30

线型已经解决！
页: [1]
查看完整版本: 关于PolyLine对象的线型和颜色的问题请教