摘要：AutoCADMAP是我們所熟知的地理信息制圖的重要軟件之一，它不僅操作方便,而且功能十分強(qiáng)大.但由于我們需求的多樣性,它在有些方面已經(jīng)不能滿足我們的需求.因此需要我們自己開發(fā)些功能來解決我們的需求問題.AutoCADMAP提供了強(qiáng)大的VBA開發(fā)技術(shù),為我們實(shí)現(xiàn)AutoCADMAP的二次開發(fā)提供了有效的途徑.本文在為提高生產(chǎn)效率與準(zhǔn)確度的環(huán)境下,基于VBA開發(fā)實(shí)現(xiàn)了AutoCADMAP電桿符號(hào)的批量轉(zhuǎn)換.
　　關(guān)鍵詞：VBA，電桿符號(hào)，AutoCADMAP
　　1引言
　　所謂電桿符號(hào)既電力機(jī)車軌道兩旁的電桿.在我們進(jìn)行數(shù)字化的時(shí)候,軌道載CAD中是一條平行雙線,而電桿則是作為符號(hào)分布在平行線的兩側(cè),而且要求符號(hào)的方向要垂直于軌道方向.通常一條軌道兩側(cè)總計(jì)會(huì)有幾千個(gè)電桿符號(hào),如果人工操作,則需要對(duì)每個(gè)符號(hào)進(jìn)行處理,旋轉(zhuǎn).這將極大的降低工作效率,而且準(zhǔn)確度也得不到保障.為解決這種需求。AutoCADMAP提供了強(qiáng)大的VBA開發(fā)技術(shù),為我們實(shí)現(xiàn)AutoCADMAP的二次開發(fā)提供了必要的接口，使我們能通過這些接口和VBA語言實(shí)現(xiàn)CAD電桿符號(hào)的批量轉(zhuǎn)換。
　　2系統(tǒng)目標(biāo)
　　利用VBA語言與AutoCADMAP二次開發(fā)接口的結(jié)合,編寫程序?qū)崿F(xiàn)電桿符號(hào)的批量轉(zhuǎn)換,提高生產(chǎn)效率,增強(qiáng)準(zhǔn)確度.
　　3系統(tǒng)設(shè)計(jì)方案
　　(1)數(shù)據(jù)錄入,把要數(shù)字化的電力機(jī)車軌道和符號(hào)輸入到AutoCADMAP中,電桿符號(hào)中心線的末端要畫在軌道上或穿過軌道,如圖1所示:
　　
　　圖1
　　(2)利用AutoCADMAP的打斷相交線工具,把剛才繪制的所有相交線打斷,刪除多余的部分,如圖2所示:
　　
　　圖2
　　(3)通過以上兩個(gè)步驟,使電力機(jī)車軌道變成了很多條線段,使每相鄰兩個(gè)電桿符號(hào)都有一段獨(dú)立的機(jī)車軌道,通過編程獲取這段機(jī)車軌道的方向(線角度),把電桿符號(hào)分別相對(duì)這個(gè)角度旋轉(zhuǎn)正90度,負(fù)90度.通過程序分別選擇所有的軌道和電桿符號(hào),通過遍歷,最終達(dá)到效果如圖3所示:
　　
　　圖3
　　4主要程序代碼:
　　SubDIANGAN()
　　DimlayerObjAsAcadLayer
　　SetlayerObj=ThisDrawing.Layers.Add("GBLOCK")
　　DimAngleFirstAsDouble
　　DimAngleSecondAsDouble
　　DimselsetAsAcadSelectionSet
　　DimselAsAcadSelectionSet
　　DimFilterType(0)AsInteger
　　DimFilterData(0)AsVariant
　　DimvarAAsVariant
　　DimvarBAsVariant
　　DimintIAsInteger
　　FilterType(0)=0
　　FilterData(0)="LWPOLYLINE"
　　varA=FilterType
　　varB=FilterData
　　IfThisDrawing.SelectionSets.Count<>0Then
　　ForintI=0ToThisDrawing.SelectionSets.Count-1
　　Setselset=ThisDrawing.SelectionSets.Item(intI)
　　selset.Delete
　　OnErrorResumeNext
　　NextintI
　　EndIf
　　sset.Delete
　　Setselset=ThisDrawing.SelectionSets.Add("SS3")
　　selset.SelectOnScreenFilterType,FilterData
　　Setsel=ThisDrawing.SelectionSets.Add("SS4")
　　FilterType(0)=0
　　FilterData(0)="LWPOLYLINE"
　　sel.SelectOnScreenFilterType,FilterData
　　DimpobAsAcadLWPolyline
　　DimPOB2AsAcadLWPolyline
　　DimJpointAsVariant,TpointAsVariant
　　DimblockBHAsAcadBlockReference
　　DimstrDirNameAsString
　　Dimbj(10000,2)AsDouble
　　DimrAsInteger,jAsInteger,cjAsInteger
　　strDirName="D:G500編輯程序dqhtl.dwg"
　　r=0
　　cj=0
　　ForEachpobInselset
　　ForEachPOB2Insel
　　cj=0
　　Jpoint=pob.IntersectWith(POB2,acExtendNone)
　　IfUBound(Jpoint)>0Then
　　Forj=0Tor-1
　　IfJpoint(0)=bj(j,0)AndJpoint(1)=bj(j,1)Then
　　cj=cj+1
　　EndIf
　　Nextj
　　bj(r,0)=Jpoint(0)
　　bj(r,1)=Jpoint(1)
　　r=r+1
　　Ifcj>0Then
　　Else
　　Dimpp(2)AsDouble
　　pp(0)=Jpoint(0)
　　pp(1)=Jpoint(1)
　　pp(2)=0
　　DimkAsInteger
　　Fork=0ToUBound(pob.Coordinates)
　　Ifpob.Coordinate(0)(0)=Jpoint(0)Andpob.Coordinate(0)(1)=Jpoint(1)Then
　　CallAngle(pob.Coordinate(0)(0),pob.Coordinate(0)(1),pob.Coordinate(1)(0),pob.Coordinate(1)(1),AngleFirst,AngleSecond)
　　Else
　　k=(UBound(pob.Coordinates)+1)/2-1
　　CallAngle(pob.Coordinate(k-1)(0),pob.Coordinate(k-1)(1),pob.Coordinate(k)(0),pob.Coordinate(k)(1),AngleFirst,AngleSecond)
　　EndIf
　　Nextk
　　SetblockBH=ThisDrawing.ModelSpace.InsertBlock(pp,strDirName,0.1,0.1,0.1,AngleFirst)
　　blockBH.Layer="GBLOCK"
　　SetblockBH=ThisDrawing.ModelSpace.InsertBlock(pp,strDirName,0.1,0.1,0.1,AngleSecond)
　　blockBH.Layer="GBLOCK"
　　EndIf
　　EndIf
　　NextPOB2
　　Nextpob
　　EndSub
　　5結(jié)束語
　　AutoCADMAP二次開發(fā)接口和VBA語言的結(jié)合所產(chǎn)生的作用是非常強(qiáng)大的,本文所實(shí)現(xiàn)的功能只是它的一個(gè)簡(jiǎn)單的典型應(yīng)用,它個(gè)更多功能還需大家去發(fā)掘去體會(huì)。
　　參考文獻(xiàn)
　　
　　[1]AutoCAD+VBA二次開發(fā)來源:InterNet明經(jīng)通道