在Autocad做圖中常需將分析或整理完成之x,y資料會成圖形,如地層剖面圖或分析線狀圖,但先決條件須將視算表之資料依據所需之格式丟出,以下為一於excel中以vba將資料丟出支小程式,提供各先進參考指正。

Sub sort1()
' sort1 巨集表
' user 在 1999/7/8 錄製的巨集
' 快速鍵: Ctrl+
location1 = "a1"
filename1 = Range(location1).Value '檔名
location1 = "b1"
path1 = Range(location1).Value '路徑
i = 2
location1 = "a" & i
g1 = Range(location1).Value
Do Until g1 = "" Or Len(g1) < 1
location1 = "a" & i
filename2 = Range(location1).Value
aaa = path1 & "\" & filename1 & "P" & filename2 & ".p"
Open aaa For Output As #1 '開檔
g2 = "newro"
Do While Len(g2) > 4
i = i + 1
location1 = "a" & i
g2 = Range(location1).Value
location1 = "b" & i
bb = Str(Range(location1).Value)
location1 = "c" & i
cc = Str(Range(location1).Value)
If Len(g2) < 4 Then Exit Do
lcc = Len(g2)
lcca = InStr(g2, "+")
lccp = InStr(g2, "-")
If lcca > 0 Then
gg1 = Val(Mid(g2, 1, lcca - 1)) * 1000
gg2 = Val(Mid(g2, lcca + 1, lcc - lcca))
gg = Str(gg1 + gg2)
Else
gg1 = Val(Mid(g2, 1, lccp - 1)) * 1000
gg2 = Val(Mid(g2, lccp + 1, lcc - lccp))
gg = Str(gg1 - gg2)
End If
Print #1, g2; Space(10 - Len(g2)); bb; Space(10 - Len(bb)); cc; Space(10 - Len(cc)); gg '資料輸出
Loop
Print #1, "END"
Close #1
g1 = g2
Loop