在AutoCAD图中快速生成电缆线径的方法

　　摘要：为了提高造船过程中查询电缆线径的工作效率，探讨利用VBA for AutoCAD结合ACCESS数据库编写程序进行自动生成的技术，实现快速地在AutoCAD图上标注出电缆的最大直径或者标称直径，以便于为设备厂商适配填料函作为参考以及放样过程中对于电缆线架的计算。

　　关键词：AutoCAD；放样；电缆外径；VBA；ACCESS

　　keywords：AutoCAD；Lafting；Cable dimeter；VBA；ACCESS

　　1 概述

　　AutoCAD(Autodesk Computer Aided Design)是一款自动计算机辅助设计 软件，用于二维绘图、详细绘制、设计文档和基本三维设计 ，现已经成为国际 上广为流行的绘图工具。在造船过程中，设计人员需要将详细设计图纸上与外围设备有关的电缆线径进行标注，发给设备厂商，以便于厂商根据船厂提供的电缆线径配置合适的填料函。利用VBA for AutoCAD 和ACCESS数据库的结合，可以快速的生成电缆线径，节省了人工查询的时间，极大的提高工作效率。

　　2 设计和制作电缆信息Access数据库

　　Microsoft Office Access是由微软发布的关系数据库管理系统 。用户可以创建表，进行查询，创建图表和报告，并且可以通过宏把他们联系在一起。Access提供功能参数化的查询，VBA for AutoCAD 可以通过DAO或ADO访问。数据库是一个系统的重要组成部分之一，它关系到整个系统的正常运行以及数据的有效处理。本系统数据库主要包含电缆线径表和电缆型号规格表。
　　2.1电缆线径表
　　主要是存放电缆的类型唯一编码、电缆类型、电缆的最小直径、公称直径以、最大直径以及电缆重量等信息，数据表结构如下： 　　2.2 电缆型号规格表
　　主要是存放电缆的类型唯一编码、电缆实际型号，电缆的信息阐述以及其他信息，数据表结构如下： 　　2.3表之间的关系类型
　　每个表中用自动增长的ID字段作为该条记录的唯一编号，通过typeid字段关联，实现一对多的关系，确保数据的完整性和真确性。 　　3  VBA应用程序
　　3.1 AUTOCAD VBA简介
　　AutoCAD为用户提供了多种二次开发工具，其中较常用的有AutoLISP、VBA、ObjectARX、.net C# 等几种方式。VBA是Visual Basic For Application的缩写，由Visual Basic派生而来，现在已经成为Microsoft产品的标准语言。和VB一样，VBA是面向对象的设计语言，它继承了VB语法简单、功能强大的特点，同时，由于VBA可与主程序在同一内存空间运行，大大提高了运行的速度。
　　3.2 系统流程图
　　系统流程图如图所示: 　　3.3  程序初始化和工具栏菜单的生成
　　Sub CreateMenu()
　　Dim curMenuGroup As AcadMenuGroup
　　Dim newMenu As AcadPopupMenu
　　Dim subMenu As AcadPopupMenu
　　Dim subSubMenu As AcadPopupMenu
　　Dim newMenuItem As AcadPopupMenuItem
　　Dim subMenuItem As AcadPopupMenuItem
　　Dim subMacro As String
　　Dim newToolBar As AcadToolbar
　　Dim newButton As AcadToolbarItem
　　Set curMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
　　On Error Resume Next
　　Set newMenu = curMenuGroup.Menus.Add("电气工具")
　　On Error Resume Next
　　Set newToolBar = curMenuGroup.Toolbars.Add("电气工具 黄海造船")
　　subMacro = "-vbarun setCableType" + Chr(32)
　　Set subMenuItem = newMenu.AddMenuItem(newMenu.count + 1, "设置电缆型号", subMacro)
　　Set newButton = newToolBar.AddToolbarButton(newToolBar.count + 1, "设置电缆型号", "设置电缆型号", subMacro)
　　newButton.SetBitmaps mypath & "tang\dis.bmp", mypath & "tang\dis.bmp"
　　curMenuGroup.Menus.InsertMenuInMenuBar "电气工具", ThisDrawing.Application.MenuBar.count + 1
　　subMacro = "-vbarun makesure" + Chr(32)
　　Set subMenuItem = newMenu.AddMenuItem(newMenu.count + 1, "确认标注", subMacro)
　　Set newButton = newToolBar.AddToolbarButton(newToolBar.count + 1, "确认标注", "确认标注", subMacro)
　　newButton.SetBitmaps mypath & "tang\right.bmp", mypath & "tang\right.bmp"
　　curMenuGroup.Menus.InsertMenuInMenuBar "电气工具", ThisDrawing.Application.MenuBar.count + 1
　　End Sub 　　3.4  设置电缆类型窗体的设计以及程序 　　Sub UserForm_Initialize()
　　power.List = Array("CJPJ96/SC", "CJPJ95/SC", "CJPJ95/NC", "CJPJ85/SC", "CJPF96/SC", "CJPF86/SC", "CJ86/SC", "CJ85/SC", "CJ86/NC", "CJ85/NC")
　　communicate.List = Array("CHJPJ85/SC", "CHJPF86/SC", "CHJPJ95/SC", "CHJPF96/SC", "CHJP86/SC", "CHJP85/SC")
　　End Sub
　　Private Sub CommandButton1_Click()
　　cableType1 = power.value
　　cableType2 = communicate.value
　　setCable.Hide
　　End Sub
　　3.5  数据库的连接
　　Dim conn As New ADODB.Connection
　　Dim rs As New ADODB.Recordset
　　Dim curpath As Variant
　　Dim sql As String
　　Dim cableName As String
　　Dim cabletype As String
　　If (cableType1 = "" Or cableType2 = "") Then
　　setCable.Show
　　End If
　　Const layerName As String = "电缆外径"
　　'-----------------数据库连接语句------------
　　conn.Provider = "Microsoft.jet.OLEDB.4.0"
　　conn.Open (mypath & "\tang\cable.mdb")
　　rs.ActiveConnection = conn
　　'-----------------数据库连接语句------------
　　3.6 数据的处理、查询以及在图纸进行标注
　　Dim area As AcadselecionSet
　　Dim ent As Object
　　Dim filtertype(5) As Integer
　　Dim filterdata(5) As Variant
　　Dim selecionCount%
　　For selecionCount = 0 To ThisDrawing.selecionSets.count - 1
　　ThisDrawing.SelectionSets.Item(selectionCount).Delete
　　Next selectionCount
　　Set area = ThisDrawing.SelectionSets.Add("area")
　　filtertype(0) = 0
　　filterdata(0) = "TEXT"
　　filtertype(1) = -4
　　filterdata(1) = " 　　filtertype(2) = 1
　　filterdata(2) = "#*[xX]*#"
　　filtertype(3) = 1
　　filterdata(3) = "#*[xX]*#*[xX]*#"
　　filtertype(4) = 1
　　filterdata(4) = "#*[xX](#*[xX]#*)"
　　filtertype(5) = -4
　　filterdata(5) = "OR>"
　　'选取电缆并进行判断和筛选
　　area.SelectonScreen filtertype, filterdata
　　'创建新图层
　　Dim layerObj As AcadLayer
　　Dim layColor As New AcadAcCmColor
　　Call layColor.SetRGB(255, 0, 0)
　　Dim cablePos As Variant
　　Dim listtext As AcadText
　　Dim textSize As Integer
　　Dim textStyle As String
　　Set layerObj = ThisDrawing.Layers.Add(layerName)
　　layerObj.TrueColor = layColor
　　For Each ent In area
　　cableName = UCase(Trim(ent.textString))  '将所有电缆去除空格变成大写
　　cablePos = ent.insertionPoint
　　textSize = ent.height
　　textStyle = ent.StyleName
　　cablePos(0) = cablePos(0) - textSize
　　cablePos(1) = cablePos(1) - 1.5 * textSize
　　'线号正则表达式  命名规范为 不超过10个的字母或数字开头，-，不超过10个字母或数字结尾
　　Dim reg1, reg2, reg3 As Object
　　Dim typeSplit As Variant
　　Dim textString As String
　　Set reg1 = CreateObject("VBscript.RegExp")
　　With reg1
　　.Global = True
　　.IgnoreCase = True
　　.Pattern = "^[1-9]\d{0,2}X\d.?\d{0,2}$"
　　End With
　　Set reg2 = CreateObject("VBscript.RegExp")
　　With reg2
　　.Global = True
　　.IgnoreCase = True
　　'.Pattern = "[1-9]X\(*"
　　.Pattern = "^[1-9]\d{0,2}X\([1-9]\d?X\d.?\d{1,2}\)$"
　　End With
　　Set reg3 = CreateObject("VBscript.RegExp")
　　With reg3
　　.Global = True
　　.IgnoreCase = True
　　.Pattern = "^[1-9]\d{0,1}X2X\d.?\d{0,2}$"
　　End With
　　If reg1.test(cableName) = True Then
　　cabletype = cableType1
　　textString = ""
　　ElseIf reg2.test(cableName) = True Then
　　cabletype = cableType1
　　typeSplit = Split(cableName, "(")
　　cableName = lef(typeSplit(1), Len(typeSplit(1)) - 1)
　　textString = typeSplit(0)
　　ElseIf reg3.test(cableName) = True Then
　　cabletype = cableType2
　　textString = ""
　　End If
　　sql = "selec detail.diameter_max as nn from detail inner join name on detail.typeid=name.typeid wher name.type='" & cabletype & "' and detail.cores= '" & cableName & "'"
　　rs.Open (sql)
　　If Not rs.EOF Then
　　Set listtext = ThisDrawing.ModelSpace.AddText(textString & "%%C" & rs!nn & "mm", cablePos, textSize)  '
　　listtext.Layer = layerName
　　listtext.TrueColor = layColor
　　listtext.StyleName = textStyle
　　listtext.Update
　　End If
　　rs.Close
　　Next
　　End Sub
　　标注前后对比结果如下： 　　4 结论
　　船舶电气在详细设计的过程中采用CAD结合 VBA程序技术，是提高图纸质量，缩短设计周期的必由之路。本文中利用VBA开发应用程序，在AutoCAD电气系统图中，自动生成电缆线径的方法，可以方便地解决查询和标注繁琐且容易产生出错的问题，可以大大提高工作效率，缩短设计周期。采用AutoCAD和Access数据库结合起来进行电缆线径标注，为企业数字化管理创造条件，既省事省力，又提高准确性，具有较大的工程使用价值。
　　版权问题：该技术文章版权归原作者所有，未经授权，不得转载和使用。