资源描述：
《基于vba技术的autocad断面数据的提取》由会员上传分享，免费在线阅读，更多相关内容在学术论文-天天文库。
1、基于VBA技术的AutoCAD断面数据的提取1引百河道清淤两期土方量计算中，实测原始断面数据作为断面清淤的第一手资料，是至关重要的，它涉及到最终的清淤工程量。但是有时施工方只提供断面设计的CAD电子文档，原始断面数据并不能直接获取，而人工从CAD图中显然不是一种准高效的方法，如何从提供的CAD电子文档中快速、准确地提取符合土方量计算要求的断面数据，是不得不解决的问题。2CAD断面数据2.1CAD多义线格式1为某设计院设计的CAD清淤断面图，黑色线是需要提取的原始断面数据。1AutoCAD断面图提
2、取数据时，首先采用AUTOCAD过滤组码与组码值创建选择集，过滤组码与组码值可以通过命令(entget(car(entsel)))获取的对象基本特性。执行该命令后得到如下信息：((-1.)(0.“LWPOLYLINE”)(330.)(5.“4B7F6”)(100.“AcDbEntity”)(67.0)(410.“Model”)(8.“DM”)(62.7)(6.“Continuous”)(100.“AcDbPolyline”)(90•10)(70.128)……其中比较常用的(0.“LWPOLYLI
3、NE”)表示对象是多义线类型；(8.”DM”)表示对象在DM层；(62.7)表示对象颜色为黑色。这样通过扩展或收缩过滤器，就可以选择需要读取数据的对象，例如：“LWPOLYLINE”：表示BuildFilterpType,pData,0建立图上所有的多段线过滤器BuildFilterpType,pData,0,“LWPOLYLINE”，8,“DM”：表示建立图层是DM的多段线过滤器BuildFilterpType,pData,0,“LWPOLYLINE”，8,“DM”，62,7:表示建立图层是D
4、M、颜色为黑色的多段线过滤。2.2创建创建过滤器遵循简单方便的原则，采用AutoCAD自带的VBA程序，在AutoCAD命令栏输入vbaide命令，切换到AutoCAD的vba界面。根据所绘图形的特点，以下为创建过滤器过程代码：PublieSubBuildFilter(TypeArray,DataArray,ParamArraygCodes())DimfType()AsInteger,fData()DimindexAsLong,iAsLongindex=LBound(gCodes)-1Fori=
5、LBound(gCodes)ToUBound(gCodes)Step2index=index+1ReDimPreservefType(0Toindex)ReDimPreservefData(0Toindex)fType(index)=CInt(gCodes(i))fData(index)=gCodes(i+1)NextTypeArray=fType：DataArray=fDataEndSub根据过滤条件，用BuildFiIter(pType,pData,0,“LWPOLYLINE”，8,“DM”
6、创建过滤器。2.3加入选择集选取符合条件的实体对象后，加入到选择集中，以下为创建选择集过程代码：PublicFunctionCreateSelectionSet(OptionalssNameAsString=“ss”)AsAcadSelectionSetDimssAsAcadSelectionSetOnErrorResumeNextIfNotIsNull(ThisDrawing.SelectionSets.Item(ssName))ThenSetss=ThisDrawing.SelectionS
7、ets.Item(ssName)ss.DeleteEndIfSetss=ThisDrawing.SelectionSets(ssName)IfErrThenSetssThisDrawing.SelectionSets.Add(ssName)ss.ClearSetCreateSelectionSet=ssEndFunction根据以上指定的过滤器建立选择集。sset.Clearsset.SelectOnScreenpType,pData选择集创建后，就可以将选择集中所有坐标点数据按需要的格式导出到
8、Excel中。3Excel相关要求3.1Excel成果表格式导出到Excel中的表格格式如图2所示，要求是表格中必须有“序号”两字，为接下来数据处理做准备2Excel表格格式3.2启动Excel在AutoCAD的VBA界面中，单击“工具-＞引用”，勾选“MicrosoftExcel14.0ObjectLibrary”库的引用，如3所示。3Excel库文件引用引用后，采用如下代码启动Excel程序。SubGetxls()OnErrorResumeNextSetxlsApp=GetObject(,“
