[教學]VBA 基本程式 拉泡泡 001
5 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共2頁)
[教學]VBA 基本程式 拉泡泡 001
' Autocad 的 VBA help 其實就寫的很清楚, 範例也很多, 但都是英文的.
' 基本寫法跟 VB6 差不多, 所以可以參考 VB6 的書, 別人不要的 VB6 書本, 可以拿來看看.
Option Explicit ' 一定要定義變數
Public Sub bubble_line() ' bubble_line 程式名稱可以自己取
On Error Resume Next ' 如果有錯誤, 不管他
Dim line_obj As AcadLine ' 定義線的變數名稱
Dim cir_obj As AcadCircle ' 定義圓的變數名稱
Dim p1 As Variant ' 定義 拉泡泡起點的變數名稱
Dim p2 As Variant ' 定義 拉泡泡終點的變數名稱
Dim int_p As Variant ' 定義 拉泡泡直線跟泡泡交點的變數名稱
Dim bubble_number As Integer ' 定義泡泡號碼的名稱
Dim text_obj As AcadText ' 定義泡泡號碼寫入文字的變數名稱
' Thisdrawing 是現在這張圖紙的意思, Utility : VBA 輸入資料等都在這一類, 公用程式
p1 = ThisDrawing.Utility.GetPoint(, "請輸入拉泡泡起點 : ")
If Err Then Exit Sub ' 如果輸入錯誤就結束程式
p2 = ThisDrawing.Utility.GetPoint(p1, "請輸入拉泡泡終點 : ") ' 如果不想輸入, 按 Esc 離開程式.
If Err Then Exit Sub
Set line_obj = ThisDrawing.ModelSpace.AddLine(p1, p2) ' 畫線
Set cir_obj = ThisDrawing.ModelSpace.AddCircle(p2, 10) ' 畫圓
' intersect 是交叉的意思, 就是求交點. acExtendNone 是線跟圓都不要延伸, 所以有幾個變數可以讓你
' 選擇要不要延伸, 例如兩條線沒有交叉, 但如果你選擇 acExtendBoth, 那就可以求到交點.
int_p = line_obj.IntersectWith(cir_obj, acExtendNone)
line_obj.Delete ' 刪除原來跟圓交叉的舊直線
Set line_obj = ThisDrawing.ModelSpace.AddLine(p1, int_p) ' 畫新的直線剛好跟圓接合
End Sub
' 基本寫法跟 VB6 差不多, 所以可以參考 VB6 的書, 別人不要的 VB6 書本, 可以拿來看看.
Option Explicit ' 一定要定義變數
Public Sub bubble_line() ' bubble_line 程式名稱可以自己取
On Error Resume Next ' 如果有錯誤, 不管他
Dim line_obj As AcadLine ' 定義線的變數名稱
Dim cir_obj As AcadCircle ' 定義圓的變數名稱
Dim p1 As Variant ' 定義 拉泡泡起點的變數名稱
Dim p2 As Variant ' 定義 拉泡泡終點的變數名稱
Dim int_p As Variant ' 定義 拉泡泡直線跟泡泡交點的變數名稱
Dim bubble_number As Integer ' 定義泡泡號碼的名稱
Dim text_obj As AcadText ' 定義泡泡號碼寫入文字的變數名稱
' Thisdrawing 是現在這張圖紙的意思, Utility : VBA 輸入資料等都在這一類, 公用程式
p1 = ThisDrawing.Utility.GetPoint(, "請輸入拉泡泡起點 : ")
If Err Then Exit Sub ' 如果輸入錯誤就結束程式
p2 = ThisDrawing.Utility.GetPoint(p1, "請輸入拉泡泡終點 : ") ' 如果不想輸入, 按 Esc 離開程式.
If Err Then Exit Sub
Set line_obj = ThisDrawing.ModelSpace.AddLine(p1, p2) ' 畫線
Set cir_obj = ThisDrawing.ModelSpace.AddCircle(p2, 10) ' 畫圓
' intersect 是交叉的意思, 就是求交點. acExtendNone 是線跟圓都不要延伸, 所以有幾個變數可以讓你
' 選擇要不要延伸, 例如兩條線沒有交叉, 但如果你選擇 acExtendBoth, 那就可以求到交點.
int_p = line_obj.IntersectWith(cir_obj, acExtendNone)
line_obj.Delete ' 刪除原來跟圓交叉的舊直線
Set line_obj = ThisDrawing.ModelSpace.AddLine(p1, int_p) ' 畫新的直線剛好跟圓接合
End Sub
Tiger&蘋果爸 寫到: 謝謝熱心程式教學分享~< 積分 +1>
[公告]關於團隊成員的回文及貢獻
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
很不錯的範例,註解的也很詳細,非常適合新手拿來觀摩!
ginse0727- 高級會員
- 文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6845
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
[教學]VBA 基本程式 002
' ******************************************************
' 第一章 樣本程式認識 / tm, tu 使用介紹
'
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
' sendcommand 在 Autocad 命令列下直接下指令
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr ' 設 undo, be, e 可以快速恢復圖面原狀
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr ' 設為世界座標
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式 _
上一行的最後面, "_" 符號, 可用來連結兩行程式, 或文字. _
, 而下一行中的 ":" 符號, 可用來連結兩行不同的程式, 減少行數
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
MsgBox tm.count ' 顯示圖面上所以物件的總數, 這樣就可以取代 Thisdrawing.Modelspace 省打字又省空間
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
' 第一章 樣本程式認識 / tm, tu 使用介紹
'
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
' sendcommand 在 Autocad 命令列下直接下指令
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr ' 設 undo, be, e 可以快速恢復圖面原狀
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr ' 設為世界座標
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式 _
上一行的最後面, "_" 符號, 可用來連結兩行程式, 或文字. _
, 而下一行中的 ":" 符號, 可用來連結兩行不同的程式, 減少行數
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
MsgBox tm.count ' 顯示圖面上所以物件的總數, 這樣就可以取代 Thisdrawing.Modelspace 省打字又省空間
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
[教學]VBA 基本程式 003
' ******************************************************
' *
' 第二章 基本繪圖, 畫線, 圓及弧 *
' *
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
' ************
' 變數定義 *
' ************
' 畫線變數定義 **************************************************
Dim line_obj As AcadLine ' 定義 line_obj 為一個線的物件
Dim start_p(0 To 2) As Double ' 定義起點及終點的座標
Dim end_p(0 To 2) As Double
' 畫圓變數定義 **************************************************
Dim circle_obj As AcadCircle ' 定義 circle_obj 為一個圓的物件
Dim circle_center(0 To 2) As Double ' 定義中心點的座標
Dim circle_radius As Double ' 定義圓的半徑
' 畫弧變數定義 **************************************************
Dim arc_obj As AcadArc ' 定義 arc_obj 為一個弧的物件
' 定義起點及終點的 "弳度", 即 = "角度" * pi
Dim start_angle, end_angle As Double
Dim arc_center(0 To 2) As Double ' 定義弧的中心點座標
Dim arc_radius As Double ' 定義弧的半徑
' ************
' 畫線工作 *
' ************
' 要從 5,5,0 到 10,10,0 畫一條線
start_p(0) = 5: start_p(1) = 5: start_p(2) = 0
end_p(0) = 10: end_p(1) = 10: end_p(2) = 0
' 在模型空間上執行畫線的動作
Set line_obj = tm.AddLine(start_p, end_p) ' 記得起頭是 Set .....
' 畫圓工作 **************************************************** _
以 5,5,0 為中心畫一個半徑為 10 的圓
circle_center(0) = 5: circle_center(1) = 5: circle_center(2) = 0
circle_radius = 10
' 在模型空間上執行畫圓的動作
Set circle_obj = tm.AddCircle(circle_center, circle_radius)
' 畫弧工作 **************************************************** _
以 30,10,0 為中心畫一個半徑 10, 起點 90 度到 終點 180 度的弧
arc_center(0) = 30: arc_center(1) = 10: arc_center(2) = 0
arc_radius = 10
start_angle = 90 * pi: end_angle = 180 * pi ' 轉換為 "弳度"
' 在模型空間上執行畫弧的動作
Set arc_obj = tm.AddArc(arc_center, arc_radius, start_angle, end_angle)
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
' *
' 第二章 基本繪圖, 畫線, 圓及弧 *
' *
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
' ************
' 變數定義 *
' ************
' 畫線變數定義 **************************************************
Dim line_obj As AcadLine ' 定義 line_obj 為一個線的物件
Dim start_p(0 To 2) As Double ' 定義起點及終點的座標
Dim end_p(0 To 2) As Double
' 畫圓變數定義 **************************************************
Dim circle_obj As AcadCircle ' 定義 circle_obj 為一個圓的物件
Dim circle_center(0 To 2) As Double ' 定義中心點的座標
Dim circle_radius As Double ' 定義圓的半徑
' 畫弧變數定義 **************************************************
Dim arc_obj As AcadArc ' 定義 arc_obj 為一個弧的物件
' 定義起點及終點的 "弳度", 即 = "角度" * pi
Dim start_angle, end_angle As Double
Dim arc_center(0 To 2) As Double ' 定義弧的中心點座標
Dim arc_radius As Double ' 定義弧的半徑
' ************
' 畫線工作 *
' ************
' 要從 5,5,0 到 10,10,0 畫一條線
start_p(0) = 5: start_p(1) = 5: start_p(2) = 0
end_p(0) = 10: end_p(1) = 10: end_p(2) = 0
' 在模型空間上執行畫線的動作
Set line_obj = tm.AddLine(start_p, end_p) ' 記得起頭是 Set .....
' 畫圓工作 **************************************************** _
以 5,5,0 為中心畫一個半徑為 10 的圓
circle_center(0) = 5: circle_center(1) = 5: circle_center(2) = 0
circle_radius = 10
' 在模型空間上執行畫圓的動作
Set circle_obj = tm.AddCircle(circle_center, circle_radius)
' 畫弧工作 **************************************************** _
以 30,10,0 為中心畫一個半徑 10, 起點 90 度到 終點 180 度的弧
arc_center(0) = 30: arc_center(1) = 10: arc_center(2) = 0
arc_radius = 10
start_angle = 90 * pi: end_angle = 180 * pi ' 轉換為 "弳度"
' 在模型空間上執行畫弧的動作
Set arc_obj = tm.AddArc(arc_center, arc_radius, start_angle, end_angle)
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
受教了....這樣的範例真的對我們新手幫助很大。
蜻蜓草- 一般會員
- 文章總數 : 77
年齡 : 47
來自 : 南投
職業 : 工
愛好 : 電影
個性 : 溫和
使用年資 : 新手初學
使用版本 : 新手初學
經驗值 : 4954
威望值 : 0
注冊日期 : 2012-08-16
回復: [教學]VBA 基本程式 拉泡泡 001
IntersectWith 好像是可以求交點的 ...有這方面的範例可以學習嗎
如果我有一條線, 可以求到該線段跟圖面上的那些線段有相交嗎0.0? 我想要求相交點的數量..
如果我有一條線, 可以求到該線段跟圖面上的那些線段有相交嗎0.0? 我想要求相交點的數量..
蜻蜓草- 一般會員
- 文章總數 : 77
年齡 : 47
來自 : 南投
職業 : 工
愛好 : 電影
個性 : 溫和
使用年資 : 新手初學
使用版本 : 新手初學
經驗值 : 4954
威望值 : 0
注冊日期 : 2012-08-16
intersectwith 用法
Dim first_obj As AcadEntity
Dim second_obj As AcadEntity
Dim pick_p As Variant ' 選取物件時, 下點的座標
Dim int_p As Variant
' 請先畫一個圓, 再畫一條線通過圓, 得到兩個交叉點
tu.GetEntity first_obj, pick_p, "請選取第一個物件! "
tu.GetEntity second_obj, pick_p, "請選取第二個物件! "
int_p = first_obj.IntersectWith(second_obj, acExtendNone)
' 交叉點 int_p 是一個 variant, 所以如果只有一個交點就會用 int_p(0) 記錄 X 座標值, int_p(1)
' 記錄 Y 座標值, int_p(2) 記錄 Z 座標值. 所以你用 Ubound(int_p) 這個函數就是顯示 2, 就是 012 的 2
' 如果是有兩個交點, int_p(3) 就會記錄第二點的 X 座標值, Ubound(int_p) 就會顯示 5 , 依此類推............
MsgBox UBound(int_p) ' 2
Dim second_obj As AcadEntity
Dim pick_p As Variant ' 選取物件時, 下點的座標
Dim int_p As Variant
' 請先畫一個圓, 再畫一條線通過圓, 得到兩個交叉點
tu.GetEntity first_obj, pick_p, "請選取第一個物件! "
tu.GetEntity second_obj, pick_p, "請選取第二個物件! "
int_p = first_obj.IntersectWith(second_obj, acExtendNone)
' 交叉點 int_p 是一個 variant, 所以如果只有一個交點就會用 int_p(0) 記錄 X 座標值, int_p(1)
' 記錄 Y 座標值, int_p(2) 記錄 Z 座標值. 所以你用 Ubound(int_p) 這個函數就是顯示 2, 就是 012 的 2
' 如果是有兩個交點, int_p(3) 就會記錄第二點的 X 座標值, Ubound(int_p) 就會顯示 5 , 依此類推............
MsgBox UBound(int_p) ' 2
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
VBA 基本程式 004
' ******************************************************
' *
' 第三章 tu.polarpoint / 給起點, 角度, 距離 *
' 得到另一點的座標 *
' *
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim line_obj As AcadLine ' 線定義
Dim circle_obj As AcadCircle ' 圓定義
' 由座標 5,5,0 的起點 p1 處, 求 45 度, 距離 10 外的 p2 點座標
Dim p1(0 To 2) As Double ' 自行定義三點座標的點定義法
Dim p2 As Variant ' variant 為不自行定義, 要由 polar 來求點的點定義法
p1(0) = 5: p1(1) = 5: p1(2) = 0 ' 三點座標定義
p2 = tu.PolarPoint(p1, 45 * pi, 10) ' 給起點, 角度, 距離
Set line_obj = tm.AddLine(p1, p2) ' 求出 p2 座標, 即可用來畫線
Set circle_obj = tm.AddCircle(p2, 10) ' 也可在 p2 上畫圓
' 下一行中的 ":" 符號, 可用來連結兩行不同的程式, 以減少行數
Set line_obj = Nothing: Set circle_obj = Nothing
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
' *
' 第三章 tu.polarpoint / 給起點, 角度, 距離 *
' 得到另一點的座標 *
' *
' ******************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub test()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim line_obj As AcadLine ' 線定義
Dim circle_obj As AcadCircle ' 圓定義
' 由座標 5,5,0 的起點 p1 處, 求 45 度, 距離 10 外的 p2 點座標
Dim p1(0 To 2) As Double ' 自行定義三點座標的點定義法
Dim p2 As Variant ' variant 為不自行定義, 要由 polar 來求點的點定義法
p1(0) = 5: p1(1) = 5: p1(2) = 0 ' 三點座標定義
p2 = tu.PolarPoint(p1, 45 * pi, 10) ' 給起點, 角度, 距離
Set line_obj = tm.AddLine(p1, p2) ' 求出 p2 座標, 即可用來畫線
Set circle_obj = tm.AddCircle(p2, 10) ' 也可在 p2 上畫圓
' 下一行中的 ":" 符號, 可用來連結兩行不同的程式, 以減少行數
Set line_obj = Nothing: Set circle_obj = Nothing
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
VBA 基本程式 005 ( 建立加入選擇集副程式 )
' 隨著程式慢慢變長變複雜, codes 也會愈來愈多, 所以就要想辦法用副程式(sub)
' 要用的時候 call 就好, 讓主程式比較簡短(concise), 有效率.
' 我使用選擇集完並不會刪除, 所以圖面上的選擇集並不會自動不見.
' 所以要再用的時候我會 call 副程式, 把剛剛用過的刪除. 不然程式不能執行, 會有錯誤.
' 其它的運用也是一樣, 要多運用副程式, 不然中大型的程式會變的很冗長!!
public sub add_selection()
Dim sset As AcadSelectionSet
Dim sset_second as AcadSelectionSet
Dim sset_third as AcadSelectionSet
add_selection_process sset, "sset_name" ' 選擇集名稱隨便打, 如果需要第二個, 第三個選擇集, 則如下
add_selection_process sset_second, "sset_second_name"
add_selection_process sset_third, "sset_third_name"
sset.Select acSelectionSetAll
MsgBox sset.count
end sub
' 加入選擇集函式
Private Sub add_selection_process(sset_obj, sset_name As String)
Dim icount As Integer
icount = ThisDrawing.SelectionSets.count
While (icount > 0) ' 每個人做法不同, 我的做法是找出這個名稱的選擇集, 然後刪除
If ThisDrawing.SelectionSets.Item(icount - 1).Name = sset_name Then
ThisDrawing.SelectionSets.Item(icount - 1).Delete
End If
icount = icount - 1
Wend
Set sset_obj = ThisDrawing.SelectionSets.Add(sset_name)
End Sub
' 要用的時候 call 就好, 讓主程式比較簡短(concise), 有效率.
' 我使用選擇集完並不會刪除, 所以圖面上的選擇集並不會自動不見.
' 所以要再用的時候我會 call 副程式, 把剛剛用過的刪除. 不然程式不能執行, 會有錯誤.
' 其它的運用也是一樣, 要多運用副程式, 不然中大型的程式會變的很冗長!!
public sub add_selection()
Dim sset As AcadSelectionSet
Dim sset_second as AcadSelectionSet
Dim sset_third as AcadSelectionSet
add_selection_process sset, "sset_name" ' 選擇集名稱隨便打, 如果需要第二個, 第三個選擇集, 則如下
add_selection_process sset_second, "sset_second_name"
add_selection_process sset_third, "sset_third_name"
sset.Select acSelectionSetAll
MsgBox sset.count
end sub
' 加入選擇集函式
Private Sub add_selection_process(sset_obj, sset_name As String)
Dim icount As Integer
icount = ThisDrawing.SelectionSets.count
While (icount > 0) ' 每個人做法不同, 我的做法是找出這個名稱的選擇集, 然後刪除
If ThisDrawing.SelectionSets.Item(icount - 1).Name = sset_name Then
ThisDrawing.SelectionSets.Item(icount - 1).Delete
End If
icount = icount - 1
Wend
Set sset_obj = ThisDrawing.SelectionSets.Add(sset_name)
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
' 設定 tm 為這張圖面的模型空間, 設定 tu 為這張圖面的公用程式
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim line_obj As AcadLine ' 線定義
Dim circle_obj As AcadCircle ' 圓定義
前面的例子是 ModelSpace
請問如果 印圖的配置空間呢?
我有2個配置空間 "配置" , "配置1"
是用PaperSpace 嗎? 怎麼指定是那一個配置空間?
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim line_obj As AcadLine ' 線定義
Dim circle_obj As AcadCircle ' 圓定義
前面的例子是 ModelSpace
請問如果 印圖的配置空間呢?
我有2個配置空間 "配置" , "配置1"
是用PaperSpace 嗎? 怎麼指定是那一個配置空間?
蜻蜓草- 一般會員
- 文章總數 : 77
年齡 : 47
來自 : 南投
職業 : 工
愛好 : 電影
個性 : 溫和
使用年資 : 新手初學
使用版本 : 新手初學
經驗值 : 4954
威望值 : 0
注冊日期 : 2012-08-16
回復: [教學]VBA 基本程式 拉泡泡 001
set tp = Thisdrawing.Paperspace 試看看, Modelspace 以外我很少用.
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
VBA basic 005 ............... VBA 有一個特殊現象, 就是定義變數的時候有一點問題. Dim aa, bb, cc, dd as Double. 一般會把很多個變數排一起可以省空間. 定義 Double, Integer, String..... 等是 OK 的. 但如果是 Dim p1, p2, p3 as Variant. 或是 Dim p1 as Variant: Dim p2 as Variant. 用冒號把兩個接成一行, 這樣在下面程式執行的時候常常會出問題. 所以定義 Variant 的時後, 最後是 Dim p1 as Variant. 換下一行 Dim p2 as Variant. 如果有人知道為什麼也可以分享一下. Thanks.
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
' 看到大家在討論處理 dwg 的問題, 想說如果把實線切成 100 段小線段, 這樣會不會有幫助, 參考一下
'
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
' 打圖面上所有實線都切成 100 段, 破壞圖面, 但看起來一樣
Public Sub line_cut()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim ent_obj As AcadObject
Dim line_obj As AcadLine
Dim start_p As Variant
Dim end_p As Variant
Dim new_line As AcadLine
Dim second_p As Variant
Dim dis As Double
Dim angle_line As Double
Dim i_count As Integer
Dim layer_obj As AcadLayer
For Each ent_obj In tm ' 懶的用選擇集, 直接從圖面過濾線段
If TypeOf ent_obj Is AcadLine Then ' Typeof 很好用, 過濾圖元類型
Set line_obj = ent_obj ' 找到線元件, 轉換設為 Acadline
Set layer_obj = ThisDrawing.Layers.Item(line_obj.Layer) ' 找線段的圖層
If layer_obj.Linetype = "CONTINUOUS" Then ' 看線段是不是實線 ??
start_p = line_obj.StartPoint: end_p = line_obj.EndPoint ' 抓起點終點
dis = line_obj.Length / 100: angle_line = line_obj.angle ' 取 1/100 的距離及角度
For i_count = 1 To 100 ' 開始畫 100 段小線條
second_p = tu.PolarPoint(start_p, angle_line, dis)
Set new_line = tm.AddLine(start_p, second_p)
new_line.Layer = line_obj.Layer: new_line.color = line_obj.color: new_line.Update
start_p = second_p ' 取剛畫好小線段的終點當新線段的起點
Next i_count
line_obj.Delete
End If
End If
Next ent_obj
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
'
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
' 打圖面上所有實線都切成 100 段, 破壞圖面, 但看起來一樣
Public Sub line_cut()
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim ent_obj As AcadObject
Dim line_obj As AcadLine
Dim start_p As Variant
Dim end_p As Variant
Dim new_line As AcadLine
Dim second_p As Variant
Dim dis As Double
Dim angle_line As Double
Dim i_count As Integer
Dim layer_obj As AcadLayer
For Each ent_obj In tm ' 懶的用選擇集, 直接從圖面過濾線段
If TypeOf ent_obj Is AcadLine Then ' Typeof 很好用, 過濾圖元類型
Set line_obj = ent_obj ' 找到線元件, 轉換設為 Acadline
Set layer_obj = ThisDrawing.Layers.Item(line_obj.Layer) ' 找線段的圖層
If layer_obj.Linetype = "CONTINUOUS" Then ' 看線段是不是實線 ??
start_p = line_obj.StartPoint: end_p = line_obj.EndPoint ' 抓起點終點
dis = line_obj.Length / 100: angle_line = line_obj.angle ' 取 1/100 的距離及角度
For i_count = 1 To 100 ' 開始畫 100 段小線條
second_p = tu.PolarPoint(start_p, angle_line, dis)
Set new_line = tm.AddLine(start_p, second_p)
new_line.Layer = line_obj.Layer: new_line.color = line_obj.color: new_line.Update
start_p = second_p ' 取剛畫好小線段的終點當新線段的起點
Next i_count
line_obj.Delete
End If
End If
Next ent_obj
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
TypeOf 沒這樣用過,謝謝前輩分享,又會了一招!
ginse0727- 高級會員
- 文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6845
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
回復: [教學]VBA 基本程式 拉泡泡 001
' 寫完程式, 執行計算完大多會開始繪圖或製做表格. 所以一堆線條圖案畫完就需要做成一個完整的圖塊, 方便移動刪除. 但不需要很正式的名稱, 所以就可以用到程式設計的 function 功 能. Dim block_name as string
block_name = rnd_process
這樣寫就可以得到一個很多個數字的字串, 因為是亂數處理, 所以不太容易會重覆.
function 功能跟 sub 不一樣, 像 rnd_process 就好像是一個字串變數可以隨意使用.
' 產生亂數
Public Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
block_name = rnd_process
這樣寫就可以得到一個很多個數字的字串, 因為是亂數處理, 所以不太容易會重覆.
function 功能跟 sub 不一樣, 像 rnd_process 就好像是一個字串變數可以隨意使用.
' 產生亂數
Public Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
十分感謝樓主的熱心大絕分享!!
這個主題一定要推一下的阿,對有心學習VBA的朋友們幫助實在很大:)
這個主題一定要推一下的阿,對有心學習VBA的朋友們幫助實在很大:)
greetingsfromtw- 初級會員
- 文章總數 : 222
年齡 : 40
來自 : 高雄
職業 : CAD菜鳥繪圖員
愛好 : 吃好吃的東西
個性 : 文靜
使用年資 : 不到兩年
使用版本 : 公司為2008,家中為2011
積分 : 3
經驗值 : 5830
威望值 : 189
注冊日期 : 2012-05-02
回復: [教學]VBA 基本程式 拉泡泡 001
我的第一個有 userform 的 VBA 程式, 上傳圖片測試
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
VBA 很重要的一部份就是 選單的製作, 以前我們公司的 Autolisp 開發者就是因為 DCL 選單開發太麻煩才停止, 改用 VBA, 現在有沒有比較方便我不知道. 但 VBA 真的很簡單, 隨便翻翻以前舊的 VB6 書籍就可以學會. 先提最重要的一點就是 Optionbutton 跟 Frame, 初學者一開始不容易懂. Optionbutton 一般就是用在多選一功能(唯一單選), 但重點就是製做完多選的按紐, 記得要全部放進 frame 的框框裏面, 這樣才可以"唯一單選", 這很重要, 其它的功能選項我想你試試就會懂, 希望這個可以幫初學者省點時間, 3QVM........
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
VBA 小技巧, 如果對一個 VBA 的指令不熟悉, 想看 Auotcad 的 on-line help. 可以將游標移到這個英文字的裏面, 然後按 F1 鍵, 就會自動出現這個指令的英文說明. 例如 Thisdrawing.Modelspace 把滑鼠游標移到 Modelspace 裏面, 按 F1 鍵, 就會出現 Modelspace 的說明, Thanks
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
' Autocad 內建範例, 如何產生 2D 聚合線介紹
Sub Example_AddLightWeightPolyline()
' This example creates a lightweight polyline in model space.
Dim plineObj As AcadLWPolyline ' 名稱可以自己取
Dim points(0 To 9) As Double ' 0, 1 代表第一點的 x, y 座標. 依此類推
' Define the 2D polyline points 定義 2D 點的座標
points(0) = 1: points(1) = 1 ' 第一點 x, y 座標
points(2) = 1: points(3) = 2 ' 第二點 x, y 座標
points(4) = 2: points(5) = 2
points(6) = 3: points(7) = 2
points(8) = 4: points(9) = 4
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
ZoomAll
End Sub
Sub Example_AddLightWeightPolyline()
' This example creates a lightweight polyline in model space.
Dim plineObj As AcadLWPolyline ' 名稱可以自己取
Dim points(0 To 9) As Double ' 0, 1 代表第一點的 x, y 座標. 依此類推
' Define the 2D polyline points 定義 2D 點的座標
points(0) = 1: points(1) = 1 ' 第一點 x, y 座標
points(2) = 1: points(3) = 2 ' 第二點 x, y 座標
points(4) = 2: points(5) = 2
points(6) = 3: points(7) = 2
points(8) = 4: points(9) = 4
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
ZoomAll
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
new_measure
看到大家在討論 measure , 所以我也來湊湊熱鬧, 我寫的這個是可以在選單上使用按鍵來直接改變圖塊間距的大小, 就可以在圖面上看到圖塊的分佈變的緊一點或鬆一點. 如果大家有興趣我可以提供檔案, 但我不知道怎麼上傳, 謝謝. new_measure module 部份的程式碼
' *************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
' 要 measure 的物件(全區域變數, 所以程式都可以讀的到)
Public ent_obj As AcadObject
Public blkref_obj As AcadBlockReference ' 圖塊
Option Explicit
Public Sub new_measure()
On Error Resume Next
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim pick_p As Variant
tu.GetEntity ent_obj, pick_p, "請選取要 measure 的物件 ! ....."
If Err Then Exit Sub
tu.GetEntity blkref_obj, pick_p, "請選取圖塊 !! ....... "
If Err Then Exit Sub
UserForm1.Show
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
' **********************************************************************
' form 的程式碼
' **********************************************************************
Public new_blkref As AcadBlockReference ' meausre 好的所有物件做成圖塊
Option Explicit
Private Sub CommandButton1_Click()
On Error Resume Next
UserForm1.Hide
new_blkref.Delete
TextBox1 = Val(TextBox1) - Val(TextBox2) ' 圖塊間距大一點
make_new_blkref ' 產生新圖塊
UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
UserForm1.Hide
new_blkref.Delete
TextBox1 = Val(TextBox1) + Val(TextBox2) ' 圖塊間距小一點
make_new_blkref
UserForm1.Show
End Sub
Private Sub CommandButton3_Click()
End
End Sub
Private Sub userform_initialize()
On Error Resume Next
TextBox1 = 100 ' 預設的數字
TextBox2 = 5
make_new_blkref
End Sub
Private Sub make_new_blkref()
On Error Resume Next
Dim block_name As String
Dim origin(0 To 2) As Double
block_name = rnd_process ' 產生薍數圖塊名稱
' 使用 measure 指令產生圖塊
ThisDrawing.SendCommand "measure" & vbCr & new_ent_obj(ent_obj) & _
vbCr & "b" & vbCr & blkref_obj.Name & vbCr & vbCr & _
Val(TextBox1) & vbCr
' 使用 "p" (previous) 指令可以將剛產生的圖變做成一個圖塊
ThisDrawing.SendCommand "-block" & vbCr & block_name & _
vbCr & "0,0,0" & vbCr & "p" & vbCr & vbCr
' 插入做好的圖塊
Set new_blkref = tm.InsertBlock(origin, block_name, 1, 1, 1, 0)
new_blkref.Update
End Sub
' 產生亂數
Private Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
' 這個功能可以讓 VBA sendcommand 指令像 lisp 一樣可以吃 物件如 Acadobject
Public Function new_ent_obj(entObj As AcadEntity) As String
'Designed to work with SendCommand, which can't pass objects.
'This gets an objects handle and converts it to a string
'of lisp commands that returns an entity name when run in SendCommand.
Dim entHandle As String
entHandle = entObj.Handle
new_ent_obj = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
' *************************************************
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
' 要 measure 的物件(全區域變數, 所以程式都可以讀的到)
Public ent_obj As AcadObject
Public blkref_obj As AcadBlockReference ' 圖塊
Option Explicit
Public Sub new_measure()
On Error Resume Next
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim pick_p As Variant
tu.GetEntity ent_obj, pick_p, "請選取要 measure 的物件 ! ....."
If Err Then Exit Sub
tu.GetEntity blkref_obj, pick_p, "請選取圖塊 !! ....... "
If Err Then Exit Sub
UserForm1.Show
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
' **********************************************************************
' form 的程式碼
' **********************************************************************
Public new_blkref As AcadBlockReference ' meausre 好的所有物件做成圖塊
Option Explicit
Private Sub CommandButton1_Click()
On Error Resume Next
UserForm1.Hide
new_blkref.Delete
TextBox1 = Val(TextBox1) - Val(TextBox2) ' 圖塊間距大一點
make_new_blkref ' 產生新圖塊
UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
UserForm1.Hide
new_blkref.Delete
TextBox1 = Val(TextBox1) + Val(TextBox2) ' 圖塊間距小一點
make_new_blkref
UserForm1.Show
End Sub
Private Sub CommandButton3_Click()
End
End Sub
Private Sub userform_initialize()
On Error Resume Next
TextBox1 = 100 ' 預設的數字
TextBox2 = 5
make_new_blkref
End Sub
Private Sub make_new_blkref()
On Error Resume Next
Dim block_name As String
Dim origin(0 To 2) As Double
block_name = rnd_process ' 產生薍數圖塊名稱
' 使用 measure 指令產生圖塊
ThisDrawing.SendCommand "measure" & vbCr & new_ent_obj(ent_obj) & _
vbCr & "b" & vbCr & blkref_obj.Name & vbCr & vbCr & _
Val(TextBox1) & vbCr
' 使用 "p" (previous) 指令可以將剛產生的圖變做成一個圖塊
ThisDrawing.SendCommand "-block" & vbCr & block_name & _
vbCr & "0,0,0" & vbCr & "p" & vbCr & vbCr
' 插入做好的圖塊
Set new_blkref = tm.InsertBlock(origin, block_name, 1, 1, 1, 0)
new_blkref.Update
End Sub
' 產生亂數
Private Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
' 這個功能可以讓 VBA sendcommand 指令像 lisp 一樣可以吃 物件如 Acadobject
Public Function new_ent_obj(entObj As AcadEntity) As String
'Designed to work with SendCommand, which can't pass objects.
'This gets an objects handle and converts it to a string
'of lisp commands that returns an entity name when run in SendCommand.
Dim entHandle As String
entHandle = entObj.Handle
new_ent_obj = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
' 在 2D 討論區有一個複線想要直接算出總長度的 case, 我試了一下, 下面的 codes 可能可以, 大家參考一下.
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub mline_length()
On Error Resume Next
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim mline As AcadMLine
Dim mline_copy As AcadMLine
Dim exp As Variant
Dim line_obj As AcadLine
Dim pline As AcadPolyline
Dim block_name As String
Dim blkref_obj As AcadBlockReference
Dim origin_p(0 To 2) As Double
Dim pick_p As Variant
block_name = rnd_process
tu.GetEntity mline, pick_p, "請選取複線 ! ....... "
If Err Then Exit Sub
Set mline_copy = mline.Copy ' copy 一份當做 last 物件, 才可以用 explode 炸開
' 因為複線 mline 在 VBA 好像沒有 explode 這個功能, 所以用 sendcommand
ThisDrawing.SendCommand "explode" & vbCr & "l" & vbCr & vbCr
' 把前面炸開的所有線段做成一個圖塊
ThisDrawing.SendCommand "-block" & vbCr & block_name & _
vbCr & "0,0,0" & vbCr & "p" & vbCr & vbCr
' 插入做好的圖塊
Set blkref_obj = tm.InsertBlock(origin_p, block_name, 1, 1, 1, 0): blkref_obj.Update
' 再把圖塊炸開, 原來的圖塊刪除
exp = blkref_obj.Explode: blkref_obj.Delete
Dim i_count As Integer
Dim total_length As Double
' 然後把所以線段的長度一個一個加總, 然後刪除
For i_count = 0 To UBound(exp)
Set line_obj = exp(i_count): line_obj.color = 3: line_obj.Update
total_length = total_length + line_obj.Length
line_obj.Delete
Next i_count
Dim text_obj As AcadText
Dim insert_p As Variant
insert_p = tu.GetPoint(, "請點選總長度插入點!! .........")
If Err Then Exit Sub
' 把得到的總長度做成文字插入圖面, 這樣比較方便, OK
Set text_obj = tm.AddText(Int(total_length), insert_p, Int(total_length / 100))
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
' 產生亂數
Private Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
Public tm As AcadModelSpace ' 定義 tm, tu 為公共變數
Public tu As AcadUtility
Public Const pi = 3.141592 / 180 ' 直接用 pi 代表
Public ent_set As AcadSelectionSet ' 大部份程式都會用到物件選擇集
Option Explicit
Public Sub mline_length()
On Error Resume Next
ThisDrawing.SendCommand "undo" & vbCr & "be" & vbCr
ThisDrawing.SendCommand "ucs" & vbCr & "w" & vbCr
Set tm = ThisDrawing.ModelSpace: Set tu = ThisDrawing.Utility
Dim mline As AcadMLine
Dim mline_copy As AcadMLine
Dim exp As Variant
Dim line_obj As AcadLine
Dim pline As AcadPolyline
Dim block_name As String
Dim blkref_obj As AcadBlockReference
Dim origin_p(0 To 2) As Double
Dim pick_p As Variant
block_name = rnd_process
tu.GetEntity mline, pick_p, "請選取複線 ! ....... "
If Err Then Exit Sub
Set mline_copy = mline.Copy ' copy 一份當做 last 物件, 才可以用 explode 炸開
' 因為複線 mline 在 VBA 好像沒有 explode 這個功能, 所以用 sendcommand
ThisDrawing.SendCommand "explode" & vbCr & "l" & vbCr & vbCr
' 把前面炸開的所有線段做成一個圖塊
ThisDrawing.SendCommand "-block" & vbCr & block_name & _
vbCr & "0,0,0" & vbCr & "p" & vbCr & vbCr
' 插入做好的圖塊
Set blkref_obj = tm.InsertBlock(origin_p, block_name, 1, 1, 1, 0): blkref_obj.Update
' 再把圖塊炸開, 原來的圖塊刪除
exp = blkref_obj.Explode: blkref_obj.Delete
Dim i_count As Integer
Dim total_length As Double
' 然後把所以線段的長度一個一個加總, 然後刪除
For i_count = 0 To UBound(exp)
Set line_obj = exp(i_count): line_obj.color = 3: line_obj.Update
total_length = total_length + line_obj.Length
line_obj.Delete
Next i_count
Dim text_obj As AcadText
Dim insert_p As Variant
insert_p = tu.GetPoint(, "請點選總長度插入點!! .........")
If Err Then Exit Sub
' 把得到的總長度做成文字插入圖面, 這樣比較方便, OK
Set text_obj = tm.AddText(Int(total_length), insert_p, Int(total_length / 100))
set_nothing_process ' 記憶體釋放
ThisDrawing.SendCommand "undo" & vbCr & "e" & vbCr
End Sub
' 產生亂數
Private Function rnd_process() As String
' 建新圖塊 ***************************
Randomize ' 對亂數產生器做初始化的動作。
rnd_process = Trim(Str(Int((9 * 10 ^ 14 * Rnd) + 10 ^ 14)))
End Function
Private Sub set_nothing_process()
Set tm = Nothing: Set tu = Nothing: Set ent_set = Nothing
End Sub
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
' 我做了一個小小的圖塊管理員, 下面是 userform 的 codes, 主程式只有 Userform1.show.
Public textbox_txt_path As String
Option Explicit
Private Sub CommandButton1_Click()
pick_block_process "c:\block_manager\001.txt"
End Sub
Private Sub pick_block_process(txt_path As String)
On Error Resume Next
Dim file_name As String
Dim file_title As String
Dim dir_name As String
Dim blkref_obj As AcadBlockReference
' 要在 Autocad VBA 使用 CommonDialog 的功能, 必須先安裝 VB 6.0. 再借用裏面的功能.
' CommonDialog 的功能有點像檔案管理員, 可以讓我們選取檔案.
CommonDialog1.InitDir = dir_name ' InitDir = Initialize dir 初始資料夾的路徑
CommonDialog1.ShowOpen ' 打開
file_name = CommonDialog1.FileName ' 含有完整路徑的檔名 例: c:\data_center\slc.dwg
file_title = CommonDialog1.FileTitle ' 只有檔名 例: sga26.dwg
' Left 的功能是從字串左邊取幾個字
dir_name = Left(file_name, Len(file_name) - Len(file_title)) ' 把完整的路徑去除檔名, 只要資料夾
If Len(Dir(txt_path)) <> 0 Then Kill txt_path ' 如果這個檔案存在就刪除
Open txt_path For Append As #1 ' 開檔寫入的功能, Append 是如果檔名不存在會自動建一個新的
Print #1, dir_name
Close #1
game_over_process
UserForm1.Hide ' 打使用介面的畫面隱藏起來, 因為要插入圖塊.
If Len(file_title) = 0 Then ' 如果沒有選取圖塊, 就回到畫面
UserForm1.Show
Else
Dim insert_p As Variant ' 插入圖塊.
insert_p = tu.GetPoint(, "請點選圖塊插入點 !! ...........")
If Err Then End
Set blkref_obj = tm.InsertBlock(insert_p, file_name, 1, 1, 1, 0)
blkref_obj.Update
End
End If
End Sub
Private Sub CommandButton2_Click()
pick_block_process "c:\block_manager\002.txt"
End Sub
Private Sub CommandButton3_Click()
pick_block_process "c:\block_manager\003.txt"
End Sub
Private Sub CommandButton37_Click()
game_over_process
End
End Sub
Private Sub CommandButton4_Click()
pick_block_process "c:\block_manager\004.txt"
End Sub
Private Sub CommandButton5_Click()
pick_block_process "c:\block_manager\005.txt"
End Sub
Private Sub CommandButton6_Click()
pick_block_process "c:\block_manager\006.txt"
End Sub
Private Sub CommandButton7_Click()
pick_block_process "c:\block_manager\007.txt"
End Sub
Private Sub CommandButton8_Click()
pick_block_process "c:\block_manager\008.txt"
End Sub
Private Sub CommandButton9_Click()
pick_block_process "c:\block_manager\009.txt"
End Sub
Private Sub CommandButton10_Click()
pick_block_process "c:\block_manager\010.txt"
End Sub
Private Sub CommandButton11_Click()
pick_block_process "c:\block_manager\011.txt"
End Sub
Private Sub CommandButton12_Click()
pick_block_process "c:\block_manager\012.txt"
End Sub
Private Sub CommandButton13_Click()
pick_block_process "c:\block_manager\013.txt"
End Sub
Private Sub CommandButton14_Click()
pick_block_process "c:\block_manager\014.txt"
End Sub
Private Sub CommandButton15_Click()
pick_block_process "c:\block_manager\015.txt"
End Sub
Private Sub CommandButton16_Click()
pick_block_process "c:\block_manager\016.txt"
End Sub
Private Sub CommandButton17_Click()
pick_block_process "c:\block_manager\017.txt"
End Sub
Private Sub CommandButton18_Click()
pick_block_process "c:\block_manager\018.txt"
End Sub
Private Sub CommandButton19_Click()
pick_block_process "c:\block_manager\019.txt"
End Sub
Private Sub CommandButton20_Click()
pick_block_process "c:\block_manager\020.txt"
End Sub
Private Sub CommandButton21_Click()
pick_block_process "c:\block_manager\021.txt"
End Sub
Private Sub CommandButton22_Click()
pick_block_process "c:\block_manager\022.txt"
End Sub
Private Sub CommandButton23_Click()
pick_block_process "c:\block_manager\023.txt"
End Sub
Private Sub CommandButton24_Click()
pick_block_process "c:\block_manager\024.txt"
End Sub
Private Sub CommandButton25_Click()
pick_block_process "c:\block_manager\025.txt"
End Sub
Private Sub CommandButton26_Click()
pick_block_process "c:\block_manager\026.txt"
End Sub
Private Sub CommandButton27_Click()
pick_block_process "c:\block_manager\027.txt"
End Sub
Private Sub CommandButton28_Click()
pick_block_process "c:\block_manager\028.txt"
End Sub
Private Sub CommandButton29_Click()
pick_block_process "c:\block_manager\029.txt"
End Sub
Private Sub CommandButton30_Click()
pick_block_process "c:\block_manager\030.txt"
End Sub
Private Sub CommandButton31_Click()
pick_block_process "c:\block_manager\031.txt"
End Sub
Private Sub CommandButton32_Click()
pick_block_process "c:\block_manager\032.txt"
End Sub
Private Sub CommandButton33_Click()
pick_block_process "c:\block_manager\033.txt"
End Sub
Private Sub CommandButton34_Click()
pick_block_process "c:\block_manager\034.txt"
End Sub
Private Sub CommandButton35_Click()
pick_block_process "c:\block_manager\035.txt"
End Sub
Private Sub CommandButton36_Click()
pick_block_process "c:\block_manager\036.txt"
End Sub
Private Sub UserForm_initialize()
On Error Resume Next
Dim text_obj As String
Dim d_count As Integer
textbox_txt_path = "c:\block_manager\textbox_txt.txt"
If Len(Dir(textbox_txt_path)) <> 0 Then
Open textbox_txt_path For Input As #1 ' 將文字檔裏的資料一個一個填到 Textbox1, Textbox2......
Do While Not EOF(1) ' Loop until end of file.
Select Case d_count
Case 0: Line Input #1, text_obj: TextBox1 = text_obj
Case 1: Line Input #1, text_obj: TextBox2 = text_obj
Case 2: Line Input #1, text_obj: TextBox3 = text_obj
Case 3: Line Input #1, text_obj: TextBox4 = text_obj
Case 4: Line Input #1, text_obj: TextBox5 = text_obj
Case 5: Line Input #1, text_obj: TextBox6 = text_obj
Case 6: Line Input #1, text_obj: TextBox7 = text_obj
Case 7: Line Input #1, text_obj: TextBox8 = text_obj
Case 8: Line Input #1, text_obj: TextBox9 = text_obj
Case 9: Line Input #1, text_obj: TextBox10 = text_obj
Case 10: Line Input #1, text_obj: TextBox11 = text_obj
Case 11: Line Input #1, text_obj: TextBox12 = text_obj
Case 12: Line Input #1, text_obj: TextBox13 = text_obj
Case 13: Line Input #1, text_obj: TextBox14 = text_obj
Case 14: Line Input #1, text_obj: TextBox15 = text_obj
Case 15: Line Input #1, text_obj: TextBox16 = text_obj
Case 16: Line Input #1, text_obj: TextBox17 = text_obj
Case 17: Line Input #1, text_obj: TextBox18 = text_obj
Case 18: Line Input #1, text_obj: TextBox19 = text_obj
Case 19: Line Input #1, text_obj: TextBox20 = text_obj
Case 20: Line Input #1, text_obj: TextBox21 = text_obj
Case 21: Line Input #1, text_obj: TextBox22 = text_obj
Case 22: Line Input #1, text_obj: TextBox23 = text_obj
Case 23: Line Input #1, text_obj: TextBox24 = text_obj
Case 24: Line Input #1, text_obj: TextBox25 = text_obj
Case 25: Line Input #1, text_obj: TextBox26 = text_obj
Case 26: Line Input #1, text_obj: TextBox27 = text_obj
Case 27: Line Input #1, text_obj: TextBox28 = text_obj
Case 28: Line Input #1, text_obj: TextBox29 = text_obj
Case 29: Line Input #1, text_obj: TextBox30 = text_obj
Case 30: Line Input #1, text_obj: TextBox31 = text_obj
Case 31: Line Input #1, text_obj: TextBox32 = text_obj
Case 32: Line Input #1, text_obj: TextBox33 = text_obj
Case 33: Line Input #1, text_obj: TextBox34 = text_obj
Case 34: Line Input #1, text_obj: TextBox35 = text_obj
Case 35: Line Input #1, text_obj: TextBox36 = text_obj
End Select
d_count = d_count + 1
Loop
Close #1
End If
End Sub
Private Sub game_over_process()
On Error Resume Next
If Len(Dir(textbox_txt_path)) <> 0 Then Kill textbox_txt_path
Open textbox_txt_path For Append As #1 ' 插入圖塊前, 要先將 Textbox 的資料回存文字檔.
Print #1, TextBox1
Print #1, TextBox2
Print #1, TextBox3
Print #1, TextBox4
Print #1, TextBox5
Print #1, TextBox6
Print #1, TextBox7
Print #1, TextBox8
Print #1, TextBox9
Print #1, TextBox10
Print #1, TextBox11
Print #1, TextBox12
Print #1, TextBox13
Print #1, TextBox14
Print #1, TextBox15
Print #1, TextBox16
Print #1, TextBox17
Print #1, TextBox18
Print #1, TextBox19
Print #1, TextBox20
Print #1, TextBox21
Print #1, TextBox22
Print #1, TextBox23
Print #1, TextBox24
Print #1, TextBox25
Print #1, TextBox26
Print #1, TextBox27
Print #1, TextBox28
Print #1, TextBox29
Print #1, TextBox30
Print #1, TextBox31
Print #1, TextBox32
Print #1, TextBox33
Print #1, TextBox34
Print #1, TextBox35
Print #1, TextBox36
Close #1
End Sub
▼下載程式:
https://app.box.com/s/qnpsow7ar2azpnqdgqjj
Public textbox_txt_path As String
Option Explicit
Private Sub CommandButton1_Click()
pick_block_process "c:\block_manager\001.txt"
End Sub
Private Sub pick_block_process(txt_path As String)
On Error Resume Next
Dim file_name As String
Dim file_title As String
Dim dir_name As String
Dim blkref_obj As AcadBlockReference
' 要在 Autocad VBA 使用 CommonDialog 的功能, 必須先安裝 VB 6.0. 再借用裏面的功能.
' CommonDialog 的功能有點像檔案管理員, 可以讓我們選取檔案.
CommonDialog1.InitDir = dir_name ' InitDir = Initialize dir 初始資料夾的路徑
CommonDialog1.ShowOpen ' 打開
file_name = CommonDialog1.FileName ' 含有完整路徑的檔名 例: c:\data_center\slc.dwg
file_title = CommonDialog1.FileTitle ' 只有檔名 例: sga26.dwg
' Left 的功能是從字串左邊取幾個字
dir_name = Left(file_name, Len(file_name) - Len(file_title)) ' 把完整的路徑去除檔名, 只要資料夾
If Len(Dir(txt_path)) <> 0 Then Kill txt_path ' 如果這個檔案存在就刪除
Open txt_path For Append As #1 ' 開檔寫入的功能, Append 是如果檔名不存在會自動建一個新的
Print #1, dir_name
Close #1
game_over_process
UserForm1.Hide ' 打使用介面的畫面隱藏起來, 因為要插入圖塊.
If Len(file_title) = 0 Then ' 如果沒有選取圖塊, 就回到畫面
UserForm1.Show
Else
Dim insert_p As Variant ' 插入圖塊.
insert_p = tu.GetPoint(, "請點選圖塊插入點 !! ...........")
If Err Then End
Set blkref_obj = tm.InsertBlock(insert_p, file_name, 1, 1, 1, 0)
blkref_obj.Update
End
End If
End Sub
Private Sub CommandButton2_Click()
pick_block_process "c:\block_manager\002.txt"
End Sub
Private Sub CommandButton3_Click()
pick_block_process "c:\block_manager\003.txt"
End Sub
Private Sub CommandButton37_Click()
game_over_process
End
End Sub
Private Sub CommandButton4_Click()
pick_block_process "c:\block_manager\004.txt"
End Sub
Private Sub CommandButton5_Click()
pick_block_process "c:\block_manager\005.txt"
End Sub
Private Sub CommandButton6_Click()
pick_block_process "c:\block_manager\006.txt"
End Sub
Private Sub CommandButton7_Click()
pick_block_process "c:\block_manager\007.txt"
End Sub
Private Sub CommandButton8_Click()
pick_block_process "c:\block_manager\008.txt"
End Sub
Private Sub CommandButton9_Click()
pick_block_process "c:\block_manager\009.txt"
End Sub
Private Sub CommandButton10_Click()
pick_block_process "c:\block_manager\010.txt"
End Sub
Private Sub CommandButton11_Click()
pick_block_process "c:\block_manager\011.txt"
End Sub
Private Sub CommandButton12_Click()
pick_block_process "c:\block_manager\012.txt"
End Sub
Private Sub CommandButton13_Click()
pick_block_process "c:\block_manager\013.txt"
End Sub
Private Sub CommandButton14_Click()
pick_block_process "c:\block_manager\014.txt"
End Sub
Private Sub CommandButton15_Click()
pick_block_process "c:\block_manager\015.txt"
End Sub
Private Sub CommandButton16_Click()
pick_block_process "c:\block_manager\016.txt"
End Sub
Private Sub CommandButton17_Click()
pick_block_process "c:\block_manager\017.txt"
End Sub
Private Sub CommandButton18_Click()
pick_block_process "c:\block_manager\018.txt"
End Sub
Private Sub CommandButton19_Click()
pick_block_process "c:\block_manager\019.txt"
End Sub
Private Sub CommandButton20_Click()
pick_block_process "c:\block_manager\020.txt"
End Sub
Private Sub CommandButton21_Click()
pick_block_process "c:\block_manager\021.txt"
End Sub
Private Sub CommandButton22_Click()
pick_block_process "c:\block_manager\022.txt"
End Sub
Private Sub CommandButton23_Click()
pick_block_process "c:\block_manager\023.txt"
End Sub
Private Sub CommandButton24_Click()
pick_block_process "c:\block_manager\024.txt"
End Sub
Private Sub CommandButton25_Click()
pick_block_process "c:\block_manager\025.txt"
End Sub
Private Sub CommandButton26_Click()
pick_block_process "c:\block_manager\026.txt"
End Sub
Private Sub CommandButton27_Click()
pick_block_process "c:\block_manager\027.txt"
End Sub
Private Sub CommandButton28_Click()
pick_block_process "c:\block_manager\028.txt"
End Sub
Private Sub CommandButton29_Click()
pick_block_process "c:\block_manager\029.txt"
End Sub
Private Sub CommandButton30_Click()
pick_block_process "c:\block_manager\030.txt"
End Sub
Private Sub CommandButton31_Click()
pick_block_process "c:\block_manager\031.txt"
End Sub
Private Sub CommandButton32_Click()
pick_block_process "c:\block_manager\032.txt"
End Sub
Private Sub CommandButton33_Click()
pick_block_process "c:\block_manager\033.txt"
End Sub
Private Sub CommandButton34_Click()
pick_block_process "c:\block_manager\034.txt"
End Sub
Private Sub CommandButton35_Click()
pick_block_process "c:\block_manager\035.txt"
End Sub
Private Sub CommandButton36_Click()
pick_block_process "c:\block_manager\036.txt"
End Sub
Private Sub UserForm_initialize()
On Error Resume Next
Dim text_obj As String
Dim d_count As Integer
textbox_txt_path = "c:\block_manager\textbox_txt.txt"
If Len(Dir(textbox_txt_path)) <> 0 Then
Open textbox_txt_path For Input As #1 ' 將文字檔裏的資料一個一個填到 Textbox1, Textbox2......
Do While Not EOF(1) ' Loop until end of file.
Select Case d_count
Case 0: Line Input #1, text_obj: TextBox1 = text_obj
Case 1: Line Input #1, text_obj: TextBox2 = text_obj
Case 2: Line Input #1, text_obj: TextBox3 = text_obj
Case 3: Line Input #1, text_obj: TextBox4 = text_obj
Case 4: Line Input #1, text_obj: TextBox5 = text_obj
Case 5: Line Input #1, text_obj: TextBox6 = text_obj
Case 6: Line Input #1, text_obj: TextBox7 = text_obj
Case 7: Line Input #1, text_obj: TextBox8 = text_obj
Case 8: Line Input #1, text_obj: TextBox9 = text_obj
Case 9: Line Input #1, text_obj: TextBox10 = text_obj
Case 10: Line Input #1, text_obj: TextBox11 = text_obj
Case 11: Line Input #1, text_obj: TextBox12 = text_obj
Case 12: Line Input #1, text_obj: TextBox13 = text_obj
Case 13: Line Input #1, text_obj: TextBox14 = text_obj
Case 14: Line Input #1, text_obj: TextBox15 = text_obj
Case 15: Line Input #1, text_obj: TextBox16 = text_obj
Case 16: Line Input #1, text_obj: TextBox17 = text_obj
Case 17: Line Input #1, text_obj: TextBox18 = text_obj
Case 18: Line Input #1, text_obj: TextBox19 = text_obj
Case 19: Line Input #1, text_obj: TextBox20 = text_obj
Case 20: Line Input #1, text_obj: TextBox21 = text_obj
Case 21: Line Input #1, text_obj: TextBox22 = text_obj
Case 22: Line Input #1, text_obj: TextBox23 = text_obj
Case 23: Line Input #1, text_obj: TextBox24 = text_obj
Case 24: Line Input #1, text_obj: TextBox25 = text_obj
Case 25: Line Input #1, text_obj: TextBox26 = text_obj
Case 26: Line Input #1, text_obj: TextBox27 = text_obj
Case 27: Line Input #1, text_obj: TextBox28 = text_obj
Case 28: Line Input #1, text_obj: TextBox29 = text_obj
Case 29: Line Input #1, text_obj: TextBox30 = text_obj
Case 30: Line Input #1, text_obj: TextBox31 = text_obj
Case 31: Line Input #1, text_obj: TextBox32 = text_obj
Case 32: Line Input #1, text_obj: TextBox33 = text_obj
Case 33: Line Input #1, text_obj: TextBox34 = text_obj
Case 34: Line Input #1, text_obj: TextBox35 = text_obj
Case 35: Line Input #1, text_obj: TextBox36 = text_obj
End Select
d_count = d_count + 1
Loop
Close #1
End If
End Sub
Private Sub game_over_process()
On Error Resume Next
If Len(Dir(textbox_txt_path)) <> 0 Then Kill textbox_txt_path
Open textbox_txt_path For Append As #1 ' 插入圖塊前, 要先將 Textbox 的資料回存文字檔.
Print #1, TextBox1
Print #1, TextBox2
Print #1, TextBox3
Print #1, TextBox4
Print #1, TextBox5
Print #1, TextBox6
Print #1, TextBox7
Print #1, TextBox8
Print #1, TextBox9
Print #1, TextBox10
Print #1, TextBox11
Print #1, TextBox12
Print #1, TextBox13
Print #1, TextBox14
Print #1, TextBox15
Print #1, TextBox16
Print #1, TextBox17
Print #1, TextBox18
Print #1, TextBox19
Print #1, TextBox20
Print #1, TextBox21
Print #1, TextBox22
Print #1, TextBox23
Print #1, TextBox24
Print #1, TextBox25
Print #1, TextBox26
Print #1, TextBox27
Print #1, TextBox28
Print #1, TextBox29
Print #1, TextBox30
Print #1, TextBox31
Print #1, TextBox32
Print #1, TextBox33
Print #1, TextBox34
Print #1, TextBox35
Print #1, TextBox36
Close #1
End Sub
▼下載程式:
https://app.box.com/s/qnpsow7ar2azpnqdgqjj
shackle_2005- 初級會員
- 文章總數 : 232
年齡 : 53
來自 : 台中
職業 : 程式設計
愛好 : 音樂
個性 : 隨和
使用年資 : 10 年
使用版本 : 2013
積分 : 3
經驗值 : 6774
威望值 : 361
注冊日期 : 2010-09-20
回復: [教學]VBA 基本程式 拉泡泡 001
老哥,VBA的推廣,您真的是不遺餘力,
這麼有心,身為人甲的我,只能給你一個讚啦!
有心學習VBA的朋友,真的不要錯過!
這麼有心,身為人甲的我,只能給你一個讚啦!
有心學習VBA的朋友,真的不要錯過!
ginse0727- 高級會員
- 文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6845
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
回復: [教學]VBA 基本程式 拉泡泡 001
是啊~論壇關於VBA文章真的不多,主要是我不擅長...也就沒有辦法參與及分享教學!ginse0727 寫到:老哥,VBA的推廣,您真的是不遺餘力,
這麼有心,身為人甲的我,只能給你一個讚啦!
有心學習VBA的朋友,真的不要錯過!
感恩 shackle_2005前輩 無私熱心分享~
____________________________________________________________________________________
👉快速比例設定與出圖技巧-線上課程(點我)👈
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共2頁)
這個論壇的權限:
您 無法 在這個版面回復文章