cad取点输出到excel及txt

《cad取点输出到excel及txt》由会员上传分享，免费在线阅读，更多相关内容在应用文档-天天文库。

1、SubCAD取点输出到Excel及Txt()OnErrorGoToveno'出错转至veno语句后执行DimxlAppAsNewExcel.ApplicationDimxlBookAsExcel.WorkbookSetxlBook=xlApp.Workbooks.AddDimxlSheetAsExcel.WorksheetSetxlSheet=xlBook.Worksheets("sheet1")'定义xlApp、xlBook、xlSheet为主程序，工作簿及工作表类型，设置xlBook为xlApp下的工作簿类的实例化对象，设置xlSheet为工作簿xlBook的一个工

2、作表'需要在工具菜单中添加MicroSoftExcel15.0labrary引用，否则无法运行DimReturnPointAsVariantDimiAsIntegerDimhighAsSingleDimPtext,FnameAsStringDimskimAsIntegerDimtextObjAsAcadTextDimpointObjAsAcadPointDimlayerObjAsAcadLayerDimdrawInCadAsBooleanDimtFnameAsStringDimeFnameAsString'以上定义需要用到的变量i=0high=1'初始化i、high变量

3、，其中i用于计数，high用于设置字体高度Fname=InputBox("请给出文件名。")'Fname返回InputBox弹出时用户输入的数据，该数据为String型，代表输出文件的文件名，本次演示输出坐标为xlsx文件及txt文件类型IfStrPtr(Fname)=0ThenExitSub'若取消则退出过程DimskimxAsStringskimx=Trim(InputBox("请给出小数点后保留几位。"))'用户输入skimx的值，skimx代表小数点后保留的位数，须转换为int型。Ifskimx=""Thenskimx="0"'若为空，则默认为“0”skim=C

4、Int(skimx)'skim定义为skimx的int型msrst=MsgBox("是否绘制在模型中？",vbYesNo,"选择是否绘制坐标")'msrst返回msgbox的结果Ifmsrst=vbYesThendrawInCad=TrueElsedrawInCad=FalseEndIf'若选是，则drawInCad值为true，代表将坐标值绘制在CAD图纸上IfFname=""ThenFname="LoactionPoints"'若用户未输入文件名，则默认为"LocationPoints"tFname="E:"&Fname&".txt"eFname="E:"&Fn

5、ame&".xlsx"'输出的txt完整目录tFname及xlsx完整目录为eFname，此时设置为E盘，用户亦可设置为其他目录xlApp.Visible=False'本过程设置excel打开时不可见，为了更好地显性展示，亦可设置为trueSetlayerObj=ThisDrawing.Layers.Add("PointsData")'添加图层“PointsData”，赋值给layerObj变量OpentFnameForOutputAs#1'txt输出时打开tFname目录，并命名为文件1DoReturnPoint=ThisDrawing.Utility.GetPoin

6、t'提示用户自己点取坐标，并返回ReturnPointi=i+1'计数器+1,此时第一个为1IfdrawInCad=TrueThen'如果选是，则绘制在Cad模型中Ptext=i&":("&Round(ReturnPoint(0),skim)&","&Round(ReturnPoint(1),skim)&")"'设置所要绘制的Ptext值，形式为“1:12444,2222”，保留小数点位数由skim决定SettextObj=ThisDrawing.ModelSpace.AddText(Ptext,ReturnPoint,high)textObj.Layer="Point

7、sData"'设置文字的起点为所点取的点位，内容为Ptext,字高为high,并设置为"PointsData"图层，此时绘制在图中SetpointObj=ThisDrawing.ModelSpace.AddPoint(ReturnPoint)pointObj.color=acGreenpointObj.Layer="PointsData"'同样设置取点处绘制点，并设置会绿色，并入"PointsData"图层Else'如果选否，则不绘制在Cad模型中SetpointObj=ThisDrawing.ModelSpace.AddPoint(Re