大家敢相信吗，原来VBA竟然可以实现电缆结构自动出图，换句话说，只要输入数据，VBA会自动将电缆的结构画出来，同时还可以渲染，结果竟然不输画图软件，真真让我刮目相看。这里我就不过多介绍VBA了，相信用过office软件的小伙伴都或多或少的接触过VBA，好的，话不多说，上干货。

本章开始我们来看一下如何做多芯线以及更复杂的多芯线，并能实现立体图。实现的结果如下：

一、可实现多芯电缆不同结构分层的图纸

 二、可实现复杂芯数电缆不同结构分层的图纸

三、可实现立体出图

 

 基于VBA实现的电缆结构自动出图有以下几个特点：

1、低成本高效率，首先不用额外安装软件，基于Excel就可以实现，同时只要输入数据，就可自动出图，避免使用画图软件，耽误较长时间画图。

2、可编辑性强，编辑Excel，就可以添加或减少结构。

3、可移植性强，换句话说，可以在任何电脑上操作，不用担心软件限制。

4、渲染的结果不输画图软件，而且颜色可通过索引号较快调整，应付紧急出图绰绰有余。

关键代码段(以下代码为实现复杂结构，即多层芯数的关键)：

ReDim cable(Cn), TB(Cn)
ReDim cable_index(Cn), TB_index(Cn)
Dim cable_c, arr_c As Variant
   arr_c = Sheet2.Range("B2:B13")
   cable_c = Application.Transpose(arr_c)
For i = 1 To C1
      Set TB(i) = Sheet1.Shapes.AddShape(msoShapeOval, X, Y, id, id)
      TB_index(i) = TB(i).Name
        TB(i).Select
      With Selection.ShapeRange
         tc = cable_c(i)
         With .Fill
        .Visible = msoTrue
        .ForeColor.SchemeColor = tc
         End With
         With .Line
        .Weight = 0.5
        .ForeColor.SchemeColor = 64
         End With
      End With
      
      
      Set cable(i) = Sheet1.Shapes.AddShape(msoShapeOval, X, Y, td, td)
       cable_index(i) = cable(i).Name
       cable(i).Select
       With Selection.ShapeRange
         With .Fill
        .Visible = msoTrue
        .ForeColor.SchemeColor = 13
         End With
         With .Line
        .Weight = 0.25
        .ForeColor.SchemeColor = 64
         End With
        .IncrementLeft 0.5 * (id - td)
        .IncrementTop 0.5 * (id - td)
         
       End With
      
      
      
       ActiveSheet.Shapes.Range(Array(i + 1, i)).Select
         Selection.ShapeRange.Group.Select
        
         With Selection.ShapeRange
         If C1 > 1 Then
         .IncrementLeft 0.5 * id * (1 / Sin(3.1416 / C1)) * Sin(2 * i * 3.1416 / C1)
         .IncrementTop -0.5 * id * (1 / Sin(3.1416 / C1)) * Cos(2 * i * 3.1416 / C1)
         End If
         End With

    Next
    
     For j = 1 To C2
      Set TB(j + C1) = Sheet1.Shapes.AddShape(msoShapeOval, X, Y, id, id)
      TB_index(j + C1) = TB(j + C1).Name
        TB(j + C1).Select
        With Selection.ShapeRange
        tc = cable_c(j + C1)
         With .Fill
        .Visible = msoTrue
        .ForeColor.SchemeColor = tc
         End With
         With .Line
        .Weight = 0.5
        .ForeColor.SchemeColor = 64
         End With
        End With
       
       
       Set cable(j + C1) = Sheet1.Shapes.AddShape(msoShapeOval, X, Y, td, td)
       cable_index(j + C1) = cable(j + C1).Name
       cable(j + C1).Select
       With Selection.ShapeRange
         With .Fill
        .Visible = msoTrue
        .ForeColor.SchemeColor = 13
         End With
         With .Line
        .Weight = 0.25
        .ForeColor.SchemeColor = 64
         End With
        .IncrementLeft 0.5 * (id - td)
        .IncrementTop 0.5 * (id - td)
         
       End With
       
       
      
         ActiveSheet.Shapes.Range(Array(j + 1 + C1, j + C1)).Select
         Selection.ShapeRange.Group.Select
        
         With Selection.ShapeRange
         If C1 = 1 Then
            di = id
         Else
         di = id * (1 / Sin(Pi / C1))
         End If
          If C1 = 1 Then
         .IncrementLeft 0.5 * (di + id) * Sin(2 * j * 3.1416 / C2)
         .IncrementTop -0.5 * (di + id) * Cos(2 * j * 3.1416 / C2)
         End If
            
         
         If C1 > 1 Then
         .IncrementLeft 0.5 * (di + 2 * id) * Sin(2 * j * 3.1416 / C2)
         .IncrementTop -0.5 * (di + 2 * id) * Cos(2 * j * 3.1416 / C2)
         End If
         End With
    Next

总结

这一系列文章暂时结束了，总体看基于VBA实现的电缆结构自动出图，代码理解不是很难，但是如果涉及结构变化或防错，还有很多工作要做，在这里就不过多介绍了。

如果大家不想自己研究，想简单点，那么大家可以到我的资源处下载。