免费发布信息
当前位置: 首页 » 技术 » 其他 » 正文

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

放大字体  缩小字体 发布日期:2017-05-19  来源:船海装备网  作者:船海装备网  浏览次数:846
核心提示:  常红艳 汤天航 王金薇  (山东黄海造船有限公司 生产设计处 电气组,山东 威海)  摘要:为了提高造船过程中查询电缆线径
  常红艳 汤天航 王金薇
  (山东黄海造船有限公司 生产设计处 电气组,山东 威海)
  摘要:为了提高造船过程中查询电缆线径的工作效率,探讨利用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电缆线径表
  主要是存放电缆的类型唯一编码、电缆类型、电缆的最小直径、公称直径以、最大直径以及电缆重量等信息,数据表结构如下:
  图一:detail.mdb (电缆线径表)设计结构
图片3
  图二:detail.mdb (电缆线径表)部分数据
图片4
  2.2 电缆型号规格表
  主要是存放电缆的类型唯一编码、电缆实际型号,电缆的信息阐述以及其他信息,数据表结构如下:
  图三:name.mdb (电缆型号规格表)设计结构
图片5
  图四:name.mdb (电缆型号规格表)部分数据
图片6
  2.3表之间的关系类型
  每个表中用自动增长的ID字段作为该条记录的唯一编号,通过typeid字段关联,实现一对多的关系,确保数据的完整性和真确性。
  图五:数据表之间的关系
图片7
  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
  图七:生成的工具栏
图片9
  3.4  设置电缆类型窗体的设计以及程序
  图八:设置电缆类型
图片10
  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
  标注前后对比结果如下:
   图九:标注前                                                  图十:标注后
     图片11                 图片12   
  4 结论
  船舶电气在详细设计的过程中采用CAD结合 VBA程序技术,是提高图纸质量,缩短设计周期的必由之路。本文中利用VBA开发应用程序,在AutoCAD电气系统图中,自动生成电缆线径的方法,可以方便地解决查询和标注繁琐且容易产生出错的问题,可以大大提高工作效率,缩短设计周期。采用AutoCAD和Access数据库结合起来进行电缆线径标注,为企业数字化管理创造条件,既省事省力,又提高准确性,具有较大的工程使用价值。
  版权问题:该技术文章版权归原作者所有,未经授权,不得转载和使用。
 
关键词: 电缆
 
[ 技术搜索 ]  [ 加入收藏 ]  [ 告诉好友 ]  [ 打印本文 ]  [ 关闭窗口 ]

 

 
推荐图文
推荐技术
点击排行