基于VBA实现电缆结构自动出图(三) —— 多芯线

大家敢相信吗,原来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实现的电缆结构自动出图,代码理解不是很难,但是如果涉及结构变化或防错,还有很多工作要做,在这里就不过多介绍了。

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

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

疯狂的豆包

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值