VBA实现AutoCadMap下电杆符号批量转换

　　摘要：AutoCADMAP是我们所熟知的地理信息制图的重要软件之一，它不仅操作方便,而且功能十分强大.但由于我们需求的多样性,它在有些方面已经不能满足我们的需求.因此需要我们自己开发些功能来解决我们的需求问题.AutoCADMAP提供了强大的VBA开发技术,为我们实现AutoCADMAP的二次开发提供了有效的途径.本文在为提高生产效率与准确度的环境下,基于VBA开发实现了AutoCADMAP电杆符号的批量转换.
　　关键词：VBA，电杆符号，AutoCADMAP
　　1引言
　　所谓电杆符号既电力机车轨道两旁的电杆.在我们进行数字化的时候,轨道载CAD中是一条平行双线,而电杆则是作为符号分布在平行线的两侧,而且要求符号的方向要垂直于轨道方向.通常一条轨道两侧总计会有几千个电杆符号,如果人工操作,则需要对每个符号进行处理,旋转.这将极大的降低工作效率,而且准确度也得不到保障.为解决这种需求。AutoCADMAP提供了强大的VBA开发技术,为我们实现AutoCADMAP的二次开发提供了必要的接口，使我们能通过这些接口和VBA语言实现CAD电杆符号的批量转换。
　　2系统目标
　　利用VBA语言与AutoCADMAP二次开发接口的结合,编写程序实现电杆符号的批量转换,提高生产效率,增强准确度.
　　3系统设计方案
　　(1)数据录入,把要数字化的电力机车轨道和符号输入到AutoCADMAP中,电杆符号中心线的末端要画在轨道上或穿过轨道,如图1所示:
　　
　　图1
　　(2)利用AutoCADMAP的打断相交线工具,把刚才绘制的所有相交线打断,删除多余的部分,如图2所示:
　　
　　图2
　　(3)通过以上两个步骤,使电力机车轨道变成了很多条线段,使每相邻两个电杆符号都有一段独立的机车轨道,通过编程获取这段机车轨道的方向(线角度),把电杆符号分别相对这个角度旋转正90度,负90度.通过程序分别选择所有的轨道和电杆符号,通过遍历,最终达到效果如图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结束语
　　AutoCADMAP二次开发接口和VBA语言的结合所产生的作用是非常强大的,本文所实现的功能只是它的一个简单的典型应用,它个更多功能还需大家去发掘去体会。
　　参考文献
　　
　　[1]AutoCAD+VBA二次开发来源:InterNet明经通道