觸探數(shù)據(jù)處理工作ver2改()(共29頁)_第1頁
觸探數(shù)據(jù)處理工作ver2改()(共29頁)_第2頁
觸探數(shù)據(jù)處理工作ver2改()(共29頁)_第3頁
觸探數(shù)據(jù)處理工作ver2改()(共29頁)_第4頁
觸探數(shù)據(jù)處理工作ver2改()(共29頁)_第5頁
已閱讀5頁,還剩25頁未讀 繼續(xù)免費(fèi)閱讀

下載本文檔

版權(quán)說明:本文檔由用戶提供并上傳,收益歸屬內(nèi)容提供方,若內(nèi)容存在侵權(quán),請進(jìn)行舉報或認(rèn)領(lǐng)

文檔簡介

1、ExcelVBA二次開發(fā)在動力觸探數(shù)據(jù)處理分析(fnx)中的應(yīng)用及與AutoCAD的轉(zhuǎn)換(zhunhun)調(diào)研(dio yn)時間:2014年6月2014年12月小組成員(土木122班):馮振興、郭海新、郭建言、戴求賢指導(dǎo)老師:摘要:針對工程上常用的軟件不具備同時繪制動力觸探擊數(shù)貫入深度曲線和進(jìn)行擊數(shù)統(tǒng)計分析的能力,基于ExcelVBA開發(fā)了動探數(shù)據(jù)分析處理、曲線繪制程序,對于提高數(shù)據(jù)量大,重復(fù)性多的動探內(nèi)業(yè)整理工作的效率,起到了很好的作用。用內(nèi)嵌的VBA語言實(shí)現(xiàn)觸探、標(biāo)貫曲線的繪制、錘擊數(shù)的修正及其各種形式的統(tǒng)計功能,如平均值、標(biāo)準(zhǔn)值、變異系數(shù)等(此過程包括其中異常值的取舍)。但EXCEL繪

2、制的觸探、標(biāo)貫表格不能填充花紋,同時繪制觸探、標(biāo)貫曲線不能表現(xiàn)在工程地質(zhì)柱狀圖和剖面圖上。關(guān)鍵詞:動力觸探,Excel,VBA,擊數(shù)貫入深度曲線,數(shù)據(jù)處理1、引言在高速公路建設(shè)中,沉管擠密碎石樁因?yàn)槠浣?jīng)濟(jì)、可靠和便于選材等優(yōu)點(diǎn)而被大量應(yīng)用于軟基加固處理中。其地基加固效果的檢測手段一般包括:采用重型動力觸探檢測樁身密實(shí)程度,用靜載法測定復(fù)合地基承載力,對樁間土進(jìn)行標(biāo)準(zhǔn)貫入試驗(yàn)及靜力觸探試驗(yàn),以判別加固后樁間土的性能。在上述檢測方法中,由于靜載試驗(yàn)耗費(fèi)大,不適于大范圍應(yīng)用。因此,目前工程上一般采用重型動力觸探來檢測軟土地基的加固效果,按照公路軟土地基路堤設(shè)計與施工技術(shù)規(guī)范(JTJ01796)的要求

3、,動力觸探抽查檢驗(yàn)數(shù)量不少于施工段總樁數(shù)的5%,且每個工區(qū)檢驗(yàn)數(shù)量不少于3根。動力觸探測試資料處理分析具有數(shù)據(jù)量大,內(nèi)業(yè)整理重復(fù)性勞動多的特點(diǎn),特別是繪制動力觸探擊數(shù)貫入深度曲線比較繁瑣,工程中常使用的繪圖軟件如AutoCAD、Excel等沒有提供直接繪制這類曲線的功能。雖然一些勘察內(nèi)業(yè)處理軟件能夠繪制動探曲線,但又缺乏對觸探擊數(shù)的統(tǒng)計分析。總之,面對大量的動探資料分析時往往因缺乏合適的分析處理工具而面臨著諸多不便,因此開發(fā)一個自動處理程序?qū)τ谔岣邉犹絻?nèi)業(yè)整理速度具有很大意義。作為優(yōu)秀的數(shù)據(jù)處理分析軟件,MicrosoftExcel被廣泛應(yīng)用于工程領(lǐng)域,其使用面非常廣,易于使用,一般工程技術(shù)人

4、員都會操作。但Excel只是提供了通用的數(shù)據(jù)輸入、管理和統(tǒng)計分析功能,對于用戶特殊的需求,需要利用Excel強(qiáng)大的二次開發(fā)功能進(jìn)行定制。本文基于Excel,針對定義好的工作表數(shù)據(jù)格式,采用ExcelVisualBasicForApplication(VBA)進(jìn)行二次開發(fā),編制了一系列的“宏”(子程序),能夠?qū)恿τ|探原位測試數(shù)據(jù)進(jìn)行統(tǒng)計分析、繪制觸探擊數(shù)深度曲線以及報表制作等數(shù)據(jù)處理工作,并能自動發(fā)送到MicrosoftWord形成Word格式的報告。實(shí)踐證明,該程序的開發(fā),對于提高動探數(shù)據(jù)處理分析的效率起到了很好的作用。但EXCEL繪制的觸探、標(biāo)貫表格(biog)不能填充花紋,同時繪制觸探、

5、標(biāo)貫曲線不能表現(xiàn)在工程地質(zhì)柱狀圖和剖面圖上。AutoCAD是由AutoDesk公司的工程(gngchng)繪圖軟件,是CAD市場的主流產(chǎn)品,功能十分強(qiáng)大,是工程制圖人員常用的軟件之一。在工程制圖中,若需要在圖中插入繪制觸探、標(biāo)貫表格和曲線,一般有兩種方法。其一,是利用剪貼板,將Microsoft Excel表格拷貝至剪貼板中,然后打開AutoCAD文件,再將剪貼板中的文件粘貼至所需位置。這種方法十分簡單,但有其固有的缺點(diǎn)。在保存文件必須將.xls和.dwg文件保存在一起,一旦(ydn)缺少excel環(huán)境,則無法再對表格繼續(xù)修改。同時打開多個表格操作,需要占據(jù)較大的內(nèi)存空間。文件體積變得很大,表

6、格有時在.dwg文件中以圖標(biāo)形式顯示,不便于觀察。、無法對表格的打印功能實(shí)現(xiàn)控制,打印出來的表格線條粗細(xì)不一,打印效果不佳。 第二種方法,AutoDesk公司從R14版以后,為其提供了VBA語言接口。利用Microsoft Excel、AutoCAD都提供的VBA功能,編制程序進(jìn)行轉(zhuǎn)換,將Microsoft Excel表格按原來樣子轉(zhuǎn)換,即把Microsoft Excel表格中的文字和線條信息全部讀取出來,在AutoCAD文件里按照一一對應(yīng)的方式寫出來,確保轉(zhuǎn)換后的表格與原表格一致。這樣徹底避免了前種方法的缺點(diǎn),便于表格內(nèi)容編輯。2、數(shù)據(jù)準(zhǔn)備及數(shù)據(jù)格式為了便于讓程序自動分析處理數(shù)據(jù),需要事先規(guī)

7、定好數(shù)據(jù)格式,在Excel工作表中輸入原始數(shù)據(jù),格式為:為每臺施工的碎石樁樁機(jī)建立一個獨(dú)立的工作簿(一般抽檢時針對每臺樁機(jī)進(jìn)行),每根樁的測試結(jié)果保存為一張獨(dú)立的工作表,表名為樁號(樁號為樁排號與列號的組合,如樁號351,其中35為樁排號,1為樁列號)。將檢測日期輸入B1單元格,樁實(shí)際的里程輸入B2單元格,擊數(shù)從B列第4行開始錄入,深度從A列第四行開始錄入(見圖1),在C2單元格填入樁機(jī)的編號。輸入以上原始數(shù)據(jù)后,可以采用編制程序的形式自動生成規(guī)范的數(shù)據(jù)表格格式。將需要統(tǒng)計的末尾行行號填入C1單元格,實(shí)際孔深填入F1單元格。由于有時會打到基巖,導(dǎo)致末尾幾行的擊數(shù)特別大(如50擊時),統(tǒng)計時應(yīng)該

8、剔除。F1單元格表示未打到基巖的最后一個擊數(shù)。在輸入樁的設(shè)計排距后,程序能自動根據(jù)樁的排號計算里程樁號,并填入B2單元格。圖1原始數(shù)據(jù)工作(gngzu)表及數(shù)據(jù)格式3、主要(zhyo)功能3.1擊數(shù)統(tǒng)計分析擊數(shù)統(tǒng)計分析主要包括兩個(lin )功能:(1)沿樁身的擊數(shù)統(tǒng)計參數(shù),包括:10cm陣擊數(shù)7(樁身達(dá)到密實(shí))的擊數(shù)百分比。程序統(tǒng)計結(jié)果自動將填入當(dāng)前工作表的D2:J6區(qū)域(參見圖1)。應(yīng)該指出:上述合格或者達(dá)到密實(shí)的擊數(shù)標(biāo)準(zhǔn)在程序中是可以自定義的,根據(jù)工程設(shè)計的要求來指定,本工程中規(guī)定10cm陣擊數(shù)5為合格,7為達(dá)到密實(shí)。另外,工程中規(guī)定一般,從地面以下開始0.5m之后才開始統(tǒng)計擊數(shù),本程序

9、提供了同時分別從地面下0.5m、1m、1.5m、2m開始統(tǒng)計的功能,結(jié)果分別輸出到圖1表中D2:J6區(qū)域的第3到第6行。統(tǒng)計時程序能夠只對當(dāng)前工作表中的當(dāng)前樁進(jìn)行統(tǒng)計,也可以針對該工作薄中全部工作表所對應(yīng)的樁進(jìn)行動力觸探擊數(shù)的統(tǒng)計。(2)統(tǒng)計連續(xù)3個10cm陣擊都小于5的段并從C28單元格開始存放,便于用戶快速判斷樁的質(zhì)量。3.2擊數(shù)貫入深度(shnd)曲線及分層(1)觸探擊數(shù)深度曲線(qxin)繪制主要提供繪制(huzh)觸探擊數(shù)深度曲線,并將單樁擊數(shù)平均值文本框添加到曲線圖上。程序能夠只對當(dāng)前工作表中的當(dāng)前樁進(jìn)行繪制,也可以針對該工作薄中全部工作表所對應(yīng)的樁進(jìn)行曲線繪制。圖2觸探擊數(shù)深度曲

10、線(qxin)繪制及根據(jù)擊數(shù)曲線進(jìn)行分層以下是繪制曲線(qxin)的程序片段:WithActiveSheetsJiHao=.Cells(2,3)startRow=4endRow=.Cells(1,3)sSheetName=.NameEndWithstrRange=A4:B+Trim$(CStr(endRow)Range(strRange).SelectCharts.Add增加(zngji)一個曲線圖ActiveChart.ChartType=xlXYScatterLinesNoMarkersActiveChart.SetSourceDataSource:=Sheets(sheetName).R

11、ange(strRange),PlotBy:=xlColumnsActiveChart.SeriesCollection(1).XValues=+sheetName+!R4C2:R+Trim$(CStr(endRow)+C2賦X值A(chǔ)ctiveChart.SeriesCollection(1).Values=+sheetName+!R4C1:R+Trim$(CStr(endRow)+C1賦Y值A(chǔ)ctiveChart.LocationWhere:=xlLocationAsObject,Name:=sheetNameWithActiveChart設(shè)置圖標(biāo)題、坐標(biāo)軸標(biāo)題等.HasTitle=True.

12、ChartTitle.Characters.Text=附圖+Trim(CStr(ActiveSheet.Index)+Trim(JiHao)+機(jī)+sheetName+樁擊數(shù)貫入深度曲線.Axes(xlCategory,xlPrimary).HasTitle=True.Axes(xlCategory,xlPrimary).AxisTitle.Characters.Text=N63.5.Axes(xlValue,xlPrimary).HasTitle=True.Axes(xlValue,xlPrimary).AxisTitle.Characters.Text=深度/mEndWithActiveCh

13、art.HasLegend=False以下再設(shè)置字體、顏色和圖尺寸、線型等。(2)分層即結(jié)合地層結(jié)構(gòu),根據(jù)觸探曲線形狀進(jìn)行力學(xué)分層,進(jìn)行分層平均擊數(shù)統(tǒng)計,在觸探擊數(shù)深度曲線上繪制分層界線。如圖2所示,從D22列開始,手工輸入各層的界限。然后運(yùn)行程序,進(jìn)行分層后的各層平均擊數(shù)統(tǒng)計,在觸探擊數(shù)深度曲線上繪制分層界線,將分層擊數(shù)文本框放到各層上,并同時統(tǒng)計連續(xù)3個10cm都小于5(可自定義的擊數(shù)合格標(biāo)準(zhǔn))的段,存放在C28單元格。以下是繪制分層水平線的程序片段:繪制分層界線DimchAsChartSetch=ActiveSheet.ChartObjects(1).ChartFori=startCol

14、+1TolastcolcInput=.Cells(startRow,i)dStart=val(cInput)dArrayX(0)=0dArrayX(1)=(Round(dAve(i-startCol)/5,0)+1)*5dArrayY(0)=dStartdArrayY(1)=dStartch.SeriesCollection.NewSeriesn=ch.SeriesCollection.Countch.SeriesCollection(n).XValues=dArrayXch.SeriesCollection(n).Values=dArrayYWithch.SeriesCollection(n

15、).Border設(shè)置線寬.ColorIndex=1.Weight=xlThin.LineStyle=xlContinuousEndWithWithch.SeriesCollection(n)設(shè)置線型.MarkerBackgroundColorIndex=xlNone.MarkerForegroundColorIndex=xlNone.MarkerStyle=xlNone.Smooth=False.MarkerSize=5.Shadow=FalseEndWithNexti分層時根據(jù)工程地質(zhì)手冊,考慮了上覆硬層及下臥軟層對擊數(shù)超前和滯后的影響,詳見手冊。3.3報表編制主要提供將各樁的統(tǒng)計成果匯總到

16、一張統(tǒng)計表中,然后將各樁的曲線自動發(fā)送到Word生成報告。(1)統(tǒng)計分析成果匯總。將各樁的統(tǒng)計數(shù)據(jù)按樁機(jī)號匯總到名叫“統(tǒng)計表”工作簿中,“統(tǒng)計表”中有一個“總計”工作表,對每一臺樁機(jī)n都有一個“統(tǒng)計n”,“分層統(tǒng)計n”的工作表分別統(tǒng)計各樁機(jī)的統(tǒng)計成果和分層的統(tǒng)計成果(如圖3)。統(tǒng)計表中含本臺樁機(jī)施工的全部抽檢樁的擊數(shù)統(tǒng)計指標(biāo),包括擊數(shù)5的百分比、擊數(shù)7的百分比樣本數(shù)、均值、最小值、最大值、標(biāo)準(zhǔn)差、變異系數(shù)、連續(xù)30cm擊數(shù)小于5的測段范圍、檢測日期、備注以及密實(shí)度評價。總計表中包含各樁機(jī)樁密實(shí)度統(tǒng)計表,分層統(tǒng)計表中各樁的分層統(tǒng)計值,主要是層號、起止深度厚度、該層的平均擊數(shù)。圖3統(tǒng)計表工作(gn

17、gzu)簿(2)統(tǒng)計完畢后,通過(tnggu)編程,自動生成階梯狀的動探曲線圖(圖4)。(3)將繪制好的動探曲線直接發(fā)送到一個(y )Word空文檔,進(jìn)行排版并設(shè)置好圖幅大小,曲線圖放在插入點(diǎn)后,當(dāng)Word提示保存時必須保存,然后再打開該文檔,將所有內(nèi)容選中并復(fù)制到報告末尾即可(圖5)。(4)最后,統(tǒng)計各樁機(jī)抽檢的總進(jìn)尺,統(tǒng)計各樁機(jī)抽檢的樁數(shù),供編寫報告用。圖4圖工作(gngzu)簿中生成的階梯狀曲線圖圖5自動(zdng)生成的Word文檔4系統(tǒng)的運(yùn)行(ynxng)環(huán)境本軟件(run jin)采用Excel2003環(huán)境(hunjng)下采用VisualBasicForApplication開發(fā)

18、,可以運(yùn)行于Excel97,2000、2003及2007下。隨后介紹EXCEL表到AUTOCAD表轉(zhuǎn)換表格轉(zhuǎn)換工作機(jī)理分析及具體實(shí)現(xiàn)方法 1表格轉(zhuǎn)換工作機(jī)理分析 在制表過程中,經(jīng)常遇到兩個概念,表和方格。在Microsoft Excel中,與表對應(yīng)的對象是工作表(Sheet或Worksheet),與每一個表格方格相對應(yīng)的對象是單元格區(qū)域(range),它可以僅包括一個單元格(cell),也可以由多個單元格合并而成。 在AutoCAD中,沒有與表對應(yīng)的對象,但表可以理解(lji)由若干條線和文字對象組合而成。 根據(jù)上述分析,可以發(fā)現(xiàn)(fxin)如下的轉(zhuǎn)換方法:讀取Microsoft Excel文

19、件(wnjin)中的最小對象單元格區(qū)域(range)的主要信息線條和文字,然后在AutoCAD文件里在指定圖層、位置畫線條,書寫文字。通過循環(huán),遍歷所有單元格區(qū)域(range),邊讀邊寫,最終完成表格的轉(zhuǎn)換。轉(zhuǎn)換過程中,保持線條、文字及其相關(guān)屬性不發(fā)生改變。 下面就轉(zhuǎn)換工作的兩個主要對象表格線條和表格文字進(jìn)行討論。 2、表格線條的轉(zhuǎn)換 Microsoft Excel 中內(nèi)嵌的VBA為我們獲取Excel文件信息提供了極大便利。通常,通過訪問range對象,可以獲得許多信息。訪問分析表格的屬性應(yīng)從分析range開始。每一個range包括許多對象和屬性,例如,font對象可以返回range的字體信息

20、。通過遍歷,即可獲得整個表格信息。獲取表格信息的目的在于準(zhǔn)確地按照位置畫表格線,同時確定文字位置。 在獲取表格信息時,存在一個最佳算法問題。以下就畫線問題為例,闡明問題和解決方法。 假設(shè)表格由a(a=1)行b(b=1)列組成,x,y為循環(huán)變量, 表格完全由單元格組成,由于在每個單元格都有4條邊,讓x從1開始循環(huán)到a, 再y從1開始循環(huán)到b,讀取每個單元格的4條邊,會讀取a*b*4次,重復(fù)讀取a*b*2次。當(dāng)x=1時,讀取上邊(shng bin);當(dāng)y=1時讀取,左邊,其余情況讀取右邊,下邊。共讀取a+b+ a*b*2次。以3行4列為例,共讀取3+4+3*4*2=31次,與實(shí)際表格的邊數(shù)相同,沒

21、有重復(fù)讀取。 對合并單元格信息的讀取是個難點(diǎn)。因?yàn)槿绻凑?nzho)單元格的位置依次讀取,那么由a行b列個單元格(cell)合并而成的單元格區(qū)域(range)僅有4條邊,采用上述計算方法,需要讀取a+b+ a*b*2次,重復(fù)讀取a+b+ a*b*2 4次。以3行4列為例,共讀取3+4+3*4*2=31次,重復(fù)讀取31 4=27次。算法有重復(fù)。如果按照行號,列號讀取,合并單元格的行號、列號只有一個,其值為最靠左、靠上的那個單元格的行號、列號。例如,將A2:E5的單元格合并后,其行號為2,列號為A。這樣由多個合并單元格組合后的表格行號、列號有間斷,不連續(xù),無法進(jìn)行循環(huán)讀取信息。筆者通過研究發(fā)現(xiàn),

22、函數(shù)address()和單元格的mergearea屬性可以獲得合并單元格的準(zhǔn)確信息。具體方法為:讀取cells(x,y)單元格時,用address()判斷包含cells(x,y)單元格的合并單元格區(qū)域c.mergearea的絕對地址,如果前4個字符與cells(x,y) 單元格的地址相同,為cells(x,y)單元格為合并單元格區(qū)域最靠上、靠左的那個合并單元格,讀取其4條邊信息,否則不讀取。這樣,徹底避免了重復(fù)讀取,同時提高了整個讀取和畫線速度。 在AutoCAD中,線條有多種,考慮能夠(nnggu)方便控制線條屬性,選用了多義線。具體命令如下: RetVal = ThisDrawing. M

23、odelSpace .AddLightWeightPolyline(VerticesList) 下面的程序(chngx)演示表格線條讀取和畫表格線的具體過程。 Sub hxw() Dim a as interger 表格(biog)的最大行數(shù) Dim b as interger 表格的最大列數(shù) Dim xinit as double 插入點(diǎn)x坐標(biāo) Dim yinit as double 插入點(diǎn)y坐標(biāo) Dim zinit as double 插入點(diǎn)z坐標(biāo) Dim xinsert as double 當(dāng)前單元格的左上角點(diǎn)的x左標(biāo) Dim yinsert as double 當(dāng)前單元格的左上角點(diǎn)的y

24、左標(biāo) Dim ptarray (0 to 2) as double Dim x as integer Dim y as integer For x =1 to a For y=1 to b Set c = xlsheet.Range(zh(y) + Trim(Str(x) 以行號、列號獲得單元格地址 Set ma = c.MergeArea 求出單元格C的合并單元格地址 If Left(Trim(ma.Address), 4) = Trim(c.Address) Then 假如c.mergearea的絕對地址(dzh),如果前4個字符與c單元格的地址相同 xl = A1: + ma.Addre

25、ss xh = xlsheet.Range(ma.Address).Width yh = xlsheet.Range(ma.Address).Height Set xlrange = xlsheet.Range(xl) xinsert = xlrange.Width xh yinsert = xlrange.Height yh xpoint = xinit + xinsert ypoint = yinit yinsert If x = 1 Then If ma.Borders(xlEdgeTop).LineStyle xlNone Then ptArray(0) = xpoint 第一點(diǎn)坐標(biāo)(

26、zubio)(數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh 第二點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 2 and 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight End If If ma.Borders(xlEdgeBottom).LineStyle xlNone Then ptArray(0) = xpoint + xh 第三點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint

27、yh ptArray(2) = xpoint 第四點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 2 and 3) ptArray(3) = ypoint yh Lineweight lwployobj, ma.Borders(xlEdgeBottom).Weight End If If y = 1 Then If ma.Borders(xlEdgeLeft).LineStyle xlNone Then ptArray(0) = xpoint 第四點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint yh ptArray(2) = xpoint 第一點(diǎn)坐標(biāo)(數(shù)組下標(biāo) 2 a

28、nd 3) ptArray(3) = ypoint End If Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight End If If ma.Borders(xlEdgeRight).LineStyle xlNone Then ptArray(0) = xpoint + xh 第二點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 0 and 1) ptArray(1) = ypoint ptArray(2) = xpoint + xh 第三點(diǎn)坐標(biāo)(zubio)(數(shù)組下標(biāo) 2 and 3) ptArray(3) = ypoint yh Lineweight l

29、wployobj, ma.Borders(xlEdgeRight).Weight End If Set lwployobj = moSpace.AddLightWeightPolyline(ptArray) 在AutoCAD文件(wnjin)里畫線 With lwployobj .Layer = 指定lwployobj所在圖層 .Color = acBlue 指定lwployobj的顏色 End With Lwployobj.Update Next y Next x End Sub 下面程序控制線條(xintio)粗細(xì) Sub Lineweight(ByVal line As Object,

30、u As Integer) Select Case u Case 1 Call line.SetWidth(0, 0.1, 0.1) Case 2 Call line.SetWidth(0, 0.3, 0.3) Case 4138 Call line.SetWidth(0, 0.5, 0.5) Case 4 Call line.SetWidth(0, 1, 1) Case Else Call line.SetWidth(0, 0.1, 0.1) End Select End Sub 下面程序完成(wn chng)列號轉(zhuǎn)換 Function zh(pp As Integer) As String

31、 If pp 26 Then zh = Chr(64 + pp) Else zh = Chr(64 + Int(pp / 26) + Chr(64 + pp Mod 26) End If End Function 3、表格文字(wnz)轉(zhuǎn)換 表格文字轉(zhuǎn)換包括表格文字本身轉(zhuǎn)換和表格文字在表格中位置的轉(zhuǎn)換兩個(lin )部分。 在AutoCAD中,文字標(biāo)注的形式有多種,與Microsoft Excel 單元格區(qū)域多行文本內(nèi)容相對應(yīng)的是多行文本命令(mng lng)。AutoCAD提供的VBA添加多行文本的命令語句是: RetVal = ThisDrawing. ModelSpace .AddMTe

32、xt(InsertionPoint, Width, Text) 通過修改RetVal的屬性可以控制表格文字在表格中的位置。 (1)表格文字本身的轉(zhuǎn)換 分析AddMText命令可以得出:表格文字所在位置、文字內(nèi)容寬度,文字內(nèi)容,均可通過此命令來添加。然而表格文字字體,大小,下劃線、上下腳標(biāo),傾斜,加粗等卻不能。一般的方法是采用修改字體形文件的方法來實(shí)現(xiàn),方法煩瑣,不便于實(shí)現(xiàn),而且僅對修改過形文件的字體有效。況且當(dāng)同一文字塊內(nèi)的不同文字的字體,大小,下劃線、上下腳標(biāo),傾斜,加粗不同時,使用修改字體形文件的方法也無法實(shí)現(xiàn)。本文介紹一種直接利用Mtext命令提供的方法進(jìn)行轉(zhuǎn)換。 在AddMText命令

33、中,影響文字內(nèi)容和文字屬性的參數(shù)(cnsh)Text。在具體文字前加上一定的控制符號可以控制文字的文字屬性,具體控制符號可以參閱AutoCAD幫助文件。例如,F(xiàn)宋體;Q18;W1.2;ABCDEFG把“ABCDEFG”設(shè)置(shzh)成宋體、向右傾斜18度,每個字的寬度是正常寬度1.2倍。 本程序具體采用的方法是:讀取Microsoft Excel文件某一單元格區(qū)域(qy)里的某第j個字符屬性(字體,大小,下劃線、上、下腳標(biāo),傾斜,加粗),讀取Microsoft Excel文件某一單元格區(qū)域里的某第j+1個字符屬性,如果與第j個字符相同,則二者采用同樣的控制符號;若不同,則從第j+1個字符開始

34、,重復(fù)前面的工作。Sub wz ( ) Char = RTrim(Left(c.Characters.Caption, 256) If Char Empty Then textStr = For j = 1 To Len(Char) If c.Characters(j, 1).Font.Underline = xlUnderlineStyleNone Then cpt = c.Characters(j, 1).Caption sonstr = ForeFontStr(c, j) tempstr = Do While j + 1 = Len(Char) sonstr1 = ForeFontStr

35、(c, j + 1) If sonstr1 = sonstr Then j = j + 1 tempstr = tempstr + c.Characters(j, 1).Caption Else Exit Do End If Loop textStr = textStr + + sonstr + cpt + tempstr + Else cpt = c.Characters(j, 1).Caption sonstr = ForeFontStr(c, j) tempstr = Do While j + 1 = Len(Char) sonstr1 = ForeFontStr(c, j + 1) I

36、f sonstr1 = sonstr Then j = j + 1 tempstr = tempstr + c.Characters(j, 1).Caption Else Exit Do End If Loop textStr = textStr + L + sonstr + cpt + tempstr + l End If Next j End If End Sub 下面函數(shù)(hnsh)控制字體本身屬性 Function ForeFontStr(m As Range, u As Integer) As String a1 = F + m.Characters(u, 1).Font.Name

37、+ ; 字體(zt) a2 = IIf(m.Characters(u, 1).Font.Superscript = True, H0.33x;A2;, ) 上腳標(biāo) a3 = IIf(m.Characters(u, 1).Font.Subscript = True, H0.33x;A0;, ) 下腳(xi jio)標(biāo) a4 = IIf(m.Characters(u, 1).Font.FontStyle = 傾斜, Q18;, ) 傾斜 a5 = IIf(m.Characters(u, 1).Font.FontStyle = 加粗, W1.2;, ) 加粗 a6 = IIf(m.Character

38、s(u, 1).Font.FontStyle = 加粗 傾斜, W1.2;Q18;, ) 加粗傾斜 ForeFontStr = a1 + a2 + a3 + a4 + a5 + a6 End Function (2).表格中表格文字位置(wi zhi)的轉(zhuǎn)換 對文字對象的屬性的直接控制(kngzh)來實(shí)現(xiàn),通過with.end with 結(jié)構(gòu)可以很容易地控制文字的高度、圖層、顏色、書寫方向。由于Mtext文字提供支持的排列位置分為9種,必須根據(jù)Microsoft Excel表格文字的排列方式加以合適的判定,然后進(jìn)行轉(zhuǎn)換。其具體的實(shí)現(xiàn)方法(fngf)詳見下面的程序。 Sub kz( ) With

39、 textObj 文字對象 .Height = textHgt .Layer = newlayer.Name 設(shè)置圖層 .Color = acRed 設(shè)置顏色 .DrawingDirection = 1 設(shè)置書寫方向 If (ma.VerticalAlignment = xlTop _ Or ma.VerticalAlignment = xlGeneral) _ And (ma.HorizontalAlignment = xlLeft _ Or ma.HorizontalAlignment = xlGeneral) _ Then .AttachmentPoint = 1 acAttachmen

40、tPointTopLeft If (ma.VerticalAlignment = xlTop _ Or ma.VerticalAlignment = xlGeneral) _ And (ma.HorizontalAlignment = xlCenter _ Or ma.HorizontalAlignment = xlJustify _ Or ma.HorizontalAlignment = xlDistributed) _ Then .AttachmentPoint = 2 acAttachmentPointTopCenter If (ma.VerticalAlignment = xlTop

41、_ Or ma.VerticalAlignment = xlGeneral) _ And ma.HorizontalAlignment = xlRight _ Then .AttachmentPoint = 3 acAttachmentPointTopRight If (ma.VerticalAlignment = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment = xlDistributed) _ And (ma.HorizontalAlignment = xlLeft _ Or ma.Hori

42、zontalAlignment = xlGeneral) _ Then .AttachmentPoint = 4 acAttachmentPointMiddleLeft If (ma.VerticalAlignment = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment = xlDistributed) _ And (ma.HorizontalAlignment = xlCenter _ Or ma.HorizontalAlignment = xlJustify _ Or ma.Horizonta

43、lAlignment = xlDistributed) _ Then .AttachmentPoint = 5 acAttachmentPointMiddleCenter If (ma.VerticalAlignment = xlCenter _ Or ma.VerticalAlignment = xlJustify _ Or ma.VerticalAlignment = xlDistributed) _ And ma.HorizontalAlignment = xlRight _ Then .AttachmentPoint = 6 acAttachmentPointMiddleRight I

44、f ma.VerticalAlignment = xlBottom _ And (ma.HorizontalAlignment = xlLeft _ Or ma.HorizontalAlignment = xlGeneral) _ Then .AttachmentPoint = 7 acAttachmentPointBottomLeft If ma.VerticalAlignment = xlBottom _ And (ma.HorizontalAlignment = xlCenter _ Or ma.HorizontalAlignment = xlJustify _ Or ma.HorizontalAlignment = xlDistributed) _ Then .AttachmentPoint = 8 acAttachmentPointBottomCenter If ma.VerticalAlignment = xlBottom _ And ma.Ho

溫馨提示

  • 1. 本站所有資源如無特殊說明,都需要本地電腦安裝OFFICE2007和PDF閱讀器。圖紙軟件為CAD,CAXA,PROE,UG,SolidWorks等.壓縮文件請下載最新的WinRAR軟件解壓。
  • 2. 本站的文檔不包含任何第三方提供的附件圖紙等,如果需要附件,請聯(lián)系上傳者。文件的所有權(quán)益歸上傳用戶所有。
  • 3. 本站RAR壓縮包中若帶圖紙,網(wǎng)頁內(nèi)容里面會有圖紙預(yù)覽,若沒有圖紙預(yù)覽就沒有圖紙。
  • 4. 未經(jīng)權(quán)益所有人同意不得將文件中的內(nèi)容挪作商業(yè)或盈利用途。
  • 5. 人人文庫網(wǎng)僅提供信息存儲空間,僅對用戶上傳內(nèi)容的表現(xiàn)方式做保護(hù)處理,對用戶上傳分享的文檔內(nèi)容本身不做任何修改或編輯,并不能對任何下載內(nèi)容負(fù)責(zé)。
  • 6. 下載文件中如有侵權(quán)或不適當(dāng)內(nèi)容,請與我們聯(lián)系,我們立即糾正。
  • 7. 本站不保證下載資源的準(zhǔn)確性、安全性和完整性, 同時也不承擔(dān)用戶因使用這些下載資源對自己和他人造成任何形式的傷害或損失。

評論

0/150

提交評論