久久青青草原国产最新片

<li id="4ehhh"><acronym id="4ehhh"></acronym></li>

  1. <tbody id="4ehhh"></tbody>

    <em id="4ehhh"><acronym id="4ehhh"></acronym></em>

      免費發布信息

      在AutoCAD圖中快速生成電纜線徑的方法

         日期:2017-05-19     來源:船海裝備網    作者:船海裝備網    瀏覽:2174    
      核心提示:  常紅艷 湯天航 王金薇  (山東黃海造船有限公司 生產設計處 電氣組,山東 威海)  摘要:為了提高造船過程中查詢電纜線徑
        常紅艷 湯天航 王金薇
        (山東黃海造船有限公司 生產設計處 電氣組,山東 威海)
        摘要:為了提高造船過程中查詢電纜線徑的工作效率,探討利用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數據庫結合起來進行電纜線徑標注,為企業數字化管理創造條件,既省事省力,又提高準確性,具有較大的工程使用價值。
        版權問題:該技術文章版權歸原作者所有,未經授權,不得轉載和使用。
       
      標簽: 電纜
      打賞
       
      更多>同類技術

      推薦圖文
      推薦技術
      點擊排行
       
      久久青青草原国产最新片
      <li id="4ehhh"><acronym id="4ehhh"></acronym></li>

      1. <tbody id="4ehhh"></tbody>

        <em id="4ehhh"><acronym id="4ehhh"></acronym></em>