AutoCAD VBA 縱斷面繪製自動化-1


範例影片：



成果圖：




是否呈現高程數字的部分可以在對話時將其關掉

 緣由：

一般在設計小型工程時(尤其是筆者所接觸的水利工程方面，高程資料是非常重要的)，必須將樁號、單距、地盤高、挖填高or其他繪製成縱斷面圖，以往都是將前人留下的舊圖，一個一個慢慢編輯，但這實在不太方便，故透過AutoCADVBA去循序讀取Excel中的資料，達成在AutoCAD圖檔中縱斷面自動生成。

方法：

本次實作將分為在Excel中以及AutoCAD兩個部分。Excel中主要是要獲得樁號、單距、相關高程、坡度、長度、樁號說明、施工建議等項目。


Run的按鈕僅是提供首次接觸該VBA的人避免填錯資料的一個引導輸入介面。

Step1:決定設計起始點，輸入S,E or S,C,E

S代表開始的樁號、C代表變換坡度的樁號、E代表結束的樁號

Step2:是否需要清除Excel中的計畫高的欄位。

如果偵測到該設計起始點編碼上的計畫高的欄位還有保留數字，會依據這個數字來給予最適坡度。




Step3:輸入原先設定為起點的計畫高



Step4:由取得參考坡度，請求輸入一較接近為整數的坡度(1:XXX)



通常最適坡度都是抓計畫高到下一樁號的地盤高來計算，除非是在Step2有保留數字則會依據計畫高到下一樁號的計畫高來計算。

P.S:下一樁號為設計起始點的部分為"C"或者"E"的樁號

Step5.於該工作表的名稱後方刮弧內更改工程名稱(還沒寫進去...可忽略第5點)




Step6.如有需要再新增自己需要的判斷高度(如右田高、路面高...ETC)

 如要新增自己的判斷高度，該欄位的名稱最後一定要是 "***高"才能被判斷

 Step7.打開AutoCAD並開啟到為可以畫圖的圖面，點擊"畫圖"

 請注意!!!這裡如果發現錯誤的話請檢查引用項目 ( VBA引用項目問題 )
或者是打開工作管理員 將所有的 "acad.exe" 結束工作(可能是開啟後隱藏在後台)
因為我的是AutoCAD 2016，所以是引用 AutoCAD 2016 Type Library，每台電腦版本不同要往下找一下。

 step8.第一列的Xscale代表X軸的比例，Yscale代表Y軸比例，基準點代表縱斷面表格在CAD左下角的位置。


Step9.可修改或不修改在縱斷面繪圖模組中有關畫圖class的程式碼參數(DrawLongtudinal)



此方法僅為初步設計，細部設計的問題再請參考(AutoCAD VBA 縱斷面自動化-常見問題)


如欲使用新版縱斷面VBA請於新視窗貼上以下連結填寫表單:


https://docs.google.com/forms/d/e/1FAIpQLSd98XpRPMAG1JQ7eCHREdsMk4gYAIXWkf5lgPWHsqVKKESrhw/viewform

---


留言

  1. ALPHAGXX2018年6月24日 晚上7:21

    HI 大大您好

    我現在用您的程式碼有些問題

    我將數據改成我的數據(只修改了樁號以及單距)

    結果CAD把CPU吃滿 等了一整天(不誇張 大概5個小時) 還是畫不出來(大約7X個橫斷面)

    可以告訴我要怎麼除錯嗎?

    回覆刪除
    回覆
    1. Hank Lin2018年7月8日 凌晨1:06

      你好，我已經更新過程式碼了，再麻煩你再試看看

      刪除
  2. liberal0102018年9月9日 晚上11:18

    你好
    我在測試您的VBA檔案的時候
    在
    With Lsec 'unit mm
    發生" 執行階段錯誤424,此處需要物件",的錯誤
    我不知道怎麼除錯，麻煩您了

    回覆刪除
    回覆
    1. Hank Lin2018年9月10日 凌晨4:17

      我想你的錯誤可能是因為版本不同的緣故，方便再多提供些相關資訊嗎?這樣比較有辦法知道錯誤在哪邊。

      刪除
    2. liberal0102019年3月20日 凌晨2:59

      果然是引用項目的CAD版本不對，已經能正常使用了，謝謝。

      刪除
  3. CHEN YU2019年3月28日 晚上10:04

    有這個自動產生縱斷面，雖然沒有CIVIL 3D或者西谷功能這個強大，對小型工程足矣~

    回覆刪除
  4. liberal0102020年10月21日 凌晨12:07

    請問輸出到CAD的數字如何讓他取到小數點後第三位？
    我不知道要修改哪一段程式碼，麻煩您了

    回覆刪除
    回覆
    1. Hank Lin2020年10月26日 下午6:33

      在模組(縱斷面設計模組)裡面的Sub ChangeLoc裡面的
      d=Format(FrontLoc,"0+000")可以更改，如果要到第三位，改成
      d=Format(FrontLoc,"0+000.000")

      刪除
  5. Unknown2020年12月3日 凌晨3:15

    由於有多個路線，請問樁號的格式可否為A0+000，B0+000等格式?謝謝 !

    回覆刪除
    回覆
    1. Hank Lin2021年3月20日 晚上7:17

      可以，請聯繫我，apple84026113@gmail.com

      刪除
  6. Unknown2021年1月28日 下午6:34

    你好 將程式碼貼上 執行時會顯示使用者自定型尚未定義?請問該從何改起?

    回覆刪除
    回覆
    1. Hank Lin2021年3月20日 晚上7:18

      這表示你的版本可能沒有2016的library，檢查一下引用項目裡面有沒有缺漏

      刪除
  7. 彥瑋2021年3月4日 凌晨12:21

    作者已經移除這則留言。

    回覆刪除
  8. jekyll1592021年4月1日 下午3:38

    請問可以分享程式嗎謝謝
    jekyll159@gmail.com

    回覆刪除
  9. 小胡2021年8月20日 晚上8:01

    請問可以分享程式嗎謝謝a0972152052@gmail.com

    回覆刪除
  10. Unknown2021年8月29日 下午6:40

    請問可以分享程式嗎???...非常感謝
    a670927@yahoo.com.tw
    a19780927@gmail.com

    回覆刪除
  11. Unknown2022年3月29日 凌晨2:53

    你好.請問可以分享程式?
    qpbmoony@gmail.com

    回覆刪除
  12. 創聚2022年5月10日 晚上11:38

    你好.請問可以分享程式? 感恩u010005@gmail.com

    回覆刪除
  13. 匿名2022年6月29日 凌晨1:04

    你好.請問可以分享程式嗎?非常感謝您~
    danny27057767@gmail.com

    回覆刪除
  14. 匿名2022年8月7日 晚上8:37

    可以分享程式嗎？工程需求～謝謝🙏

    回覆刪除
  15. 匿名2022年8月7日 晚上8:37

    可以分享程式嗎？工程需求～謝謝🙏
    chou790103@gmail.con

    回覆刪除
  16. 匿名2022年8月7日 晚上8:38

    chou790103@gmail.com

    回覆刪除
  17. 大均2022年11月22日 凌晨12:51

    請問可以分享程式嗎?非常感謝您~
    zerozero6795@gmail.com

    回覆刪除
  18. 大均2023年3月8日 下午5:29

    AutoCAD VBA 縱斷面繪製自動化，提升作業效率以節省時間確實好用。

    回覆刪除
  19. 匿名2023年3月31日 凌晨12:06

    版主，您好，謝謝您分享這麼好的資訊，可以向您請教一下，方便分享程式嗎？我的E-mail：back3338@gmail.com

    回覆刪除
  20. 匿名2023年8月8日 凌晨2:12

    可以分享程式嗎？工程需求～謝謝
    cherry0903@gmail.com

    回覆刪除
  21. 許西蒙2023年9月18日 晚上8:23

    竟然有這麼厲害的程式!!可以分享嗎？工程需求～謝謝
    simon13016@gmail.com

    回覆刪除
  22. 匿名2023年11月17日 凌晨1:01

    請問可以分享程式嗎謝謝gary10206@hotmail.com

    回覆刪除
  23. 匿名2024年5月1日 凌晨1:14

    Sub writeexcel()
    Dim excelapp As Excel.Application '定義excle應用程式變數
    Dim excelsheet As worksheet '定義工作表變數
    Dim ent As AcadBlockReference '定義塊屬性變數
    Dim yline As Integer
    Set excelapp = CreateObject("excel.application") '啟動excel程式
    excelapp.Workbooks.Open (ThisDrawing.Path & "/物件長度test.xlsx") '打開工作薄
    Set excelsheet = excelapp.ActiveWorkbook.Sheets("sheet1") '當前工作表為sheet1
    yline = 1 '寫入行位置
    For Each ent In ThisDrawing.ModelSpace '在模型空間裡迴圈
    obname = ent.ObjectName '提取對象類型
    If obname = "AcDbBlockReference" Then '判斷物件是否為塊
    xy = ent.InsertionPoint '獲取插入點座標
    varattr = ent.GetAttributes ' 將屬性標記和值複製到varattr變數
    attrtxt0 = varattr(0).TextString '屬性值
    attrtxt1 = varattr(1).TextString

    excelsheet.Cells(yline, 1).Value = attrtxt0 '寫入excle文件
    excelsheet.Cells(yline, 2).Value = attrtxt1
    excelsheet.Cells(yline, 3).Value = xy(0)
    excelsheet.Cells(yline, 4).Value = xy(1)
    yline = yline + 1 '位置加一行
    End If
    Next
    excelsheet.SaveAs "物件長度test.xlsx" '保存，檔案名是"物件長度test.xlsx"
    excelapp.Quit '退出excel程式
    Set excelapp = Nothing '釋放變數
    Set excelsheet = Nothing
    End Sub

    你好,請教一下,程式構思：
    開啟EXCEL檔,把CAD的屬性圖塊的標籤內容寫入EXCEL檔.
    執行後出現:執行階段錯誤9:陣列索引超出範圍,
    請問程式內容應該如何修改?

    回覆刪除
  24. Jeff2024年5月1日 凌晨1:31

    更新,上面問題已找到解決方法

    回覆刪除
  25. 匿名2026年7月21日 上午11:04

    可以分享程式嗎？工程需求～謝謝🙏
    sam0905138531@gmail.com

    回覆刪除

張貼留言

Popular Posts

Excel VBA @ 監造日報表、查驗表 -2

圖片
***如需施工日誌請參考 這裡 *** 20250106更新: 新的部落格連結 新版本20111214 已經更新!! 前言： 在經歷多次改版，發現使用的步驟還是有點多餘而且不夠自動化，此次將用物件類別模組的方式來修改Ver1.0留下尚可使用的程式碼，打造嶄新的監造日報表Ver2.0，輸出模式改為PDF，請搭配 PDFBinder 進行使用會比較方便。 準備文件： 以PCCES所編制並匯出成Excel之預算書報表 工程預算書中的數量計算表、土方計算表 監造日報表VBA使用手冊( 下載點我 ) 請開啟巨集並於login頁註冊後登入即可使用 圖一、Login頁面中點選註冊後跳至Google表單，填寫後即可以登入使用 參考文章： 專文1-PCCES處理到預算書 專文2-基本資料填寫 專文3-整個報表的靈魂 專文4-預定進度湊不到100%的解法  (20221204更新) 使用過程簡介： 1.  於工作表("Main")中填寫有關 工程名稱、 試體名稱(P.S.1) 、施工渠道名稱、進度資料等。 2.  於工作表("Budget")中點選"取得預算書"，修正為圖二所展示的內容。 圖二、取得預算書結果，如果需要整理準則，請參考設定準則的註解進行設定，並點選"重整準則" 3.  整理完成後並且更改為契約單價後，點選"匯出至報表"，資料會傳送至工作表("Main")，如下圖三所展示。 圖三、工作表("Main")中的報表資料，A~E欄為放置Step1 中的基本資料。 4.  於工作表("Records")中點選"填寫表單"，如圖四，即可進行一系列的資料紀錄，      為供應Diary及Check的基底資料。 圖四、施作項目來源是Main中的試體名稱與報表資料，如填寫資料有需要進行查驗，可以直接勾選(可複選) 5. 填寫完之後點選"傳送至Check"，再至工作表("Check")中點選"列印查驗"，     成果將輸出到該目錄下的查驗表Out...
Read more »

ExcelVBA@施工照片整理的應用範例

圖片
前言： 施工照片或者查驗照片對於許多工程人員來說，是個繁瑣的麻煩事。畢竟照片只是一張圖片，需要用人眼去判讀才有辦法了解內容是什麼，因為通常會有一張白板與工地現場進行合照，然而當撰寫白板的人寫字醜到不行時，會使人瘋狂。因此在施工照片的整理上，只要能解決 照片的資訊標示 與 報表位置自動貼附並調整大小 ，想必會讓各位有此類需求的工程人員節省許多時間。 相片的收集來源有以下方式 從相機的SD卡或手機連接USB直接進行下載，其檔案名稱通常為IMG_XXXX 或 DCIM_XXXX 。 透過LINE社群中建立相簿，並將同類屬性的照片丟進同一個相簿中，爾後再透過LINE電腦版將整本相簿進行下載，其檔案名稱通常為 LINE_ALBUM_相簿名稱_XXXX 。 上述兩種方式為筆者曾經使用過的方法，於資料夾檢視情況下僅有縮圖及沒有資訊標示的檔案名稱，需要雙擊展開大圖後才有辦法判讀該相片的用途，雖然上面有一張小白板的合照，但還是需要點開之後才有辦法了解內容是什麼，而【點開】並做【資訊標示】， 本身就是一件很麻煩的事 。 解決方案： 筆者的作法是將照片先整理至一個資料夾的底下，並透過LINE相簿在進行批次下載時指定其子資料夾名稱。之後便透過我所撰寫的【施工照片瀏覽及更名】的VBA小程式進行照片的資訊標示與報表輸出，詳細操作流程如下 點擊【取得資料夾】按鈕，選取已整理好的根資料夾位置。 點擊【貼上結果】按鈕，選取是否要在工作表上顯示縮圖及大小。 移動至工作表(Result)，若於工作表(Main)中有設定顯示大圖，則進入工作表(Result)中便會根據滑鼠選取的欄位顯示相對應的大圖資訊，並留有資訊標示欄位供使用者輸入做修改。 圖一、施工照片大圖資訊 有關施工照片資訊標示均輸入完畢之後，移動至工作表(Main)點擊【更換檔名】按鈕，以VBA可判讀的資訊標示的格式進行檔案名稱儲存，未來若有相對應的格式，系統會自動判讀並做預先設定，不用再輸入一次。 點擊【列印報表】按鈕，將會依照排序方法(時間或者項目)，依序將照片自動貼上於報表中並轉換成XLS或PDF， 製作成PDF才有辦法將檔案發布給其他人使用 ，如為XLS則會在自身電腦中並帶有照片原始檔的狀況下才能看到圖片。 圖三、施工照片報表輸出PDF模式。 圖三、施工照片報表輸出XLS。 若有施工照片需要的朋友們 施工照片VBA買斷版連結 *0313更...
Read more »

Excel表轉出至CAD

圖片
在進行施工設計時，常使用Excel來進行數據的運算，常見有： 主結構配筋的時候要試算鋼筋數量、長度、重量 → 鋼筋數量表 主結構重要數量核算 → 材料數量表 渠道使用明渠水理試算 → 水理因素表 當然需要的表格不僅有這些，還有拉力強度、彎距強度...等等的試算(在一些重要的結構物上)，但我也沒碰過故不清楚這部分。 在CAD中畫圖時，將Excel表轉至CAD檔方法有： 利用AutoCAD插入表格，然後導入Excel檔。 複製/貼上，將Excel要得區域複製，到AutoCAD中貼上。 利用第三方軟體，做AutoCAD與Excel橋接。 詳細圖片說明請參考 ：  營建的馬克與電腦 筆者認為第三方軟體也是需要花錢的，故寫了個VBA供大家參考使用： 下載連結：  ExcelToCAD_ConverceData.dvb 程式使用方法展示：       1.   輸入你要前往的工作表位置 ( 請輸入名稱索引 , 最前方的數字 ) ，按下 Enter          ※如果偵測到工作表的頁數超過一頁的話才會啟動詢問 2.  直接選擇你要轉換的連結區域後，按下 Enter 20190307更新: 上述的原始碼還是有一點寫太麻煩了，這次直接實作一個clsExcelToCAD物件並同時引用clsACAD物件，執行主要程序為ExportToCAD，偵測的內容是被框選到的儲存格，如果為合併儲存格則強迫畫外框，如果為單一儲存格則偵測是否上下左右邊界有無畫線，有畫線則有外框。 Private MyACAD As New clsACAD Const TXT_COE = 0.8 Const ROW_COE = 0.335 Const COL_COE = 2.1 Public lupt As Variant Private rng_start As Range Private rng_end As Range Private rng_first As Range Sub ExportToCAD() For Each rng In Selection ...
Read more »