资源描述：
《AutoCAD VBA自动获取Excel数据生成塔基断面图》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。
1、AutoCADVBA编程：自动获取Excel数据生成塔脚断面图原以为这辈子再不会写程序了，无奈，还得继续…… 1、测量原始数据、处理结果。如图： 2、原始数据录入Excel ,并整理如下格式： 3、因断面图用于设计高低柱、长短腿，在AutoCAD里面只生成A、B、C、D四个腿、以及横线路方向（E）即可。在CADVBA程序管理器中录入以下程序段： Subyema()DimxcelAppAsExcel.ApplicationDimxcelSheetAsExcel.WorksheetDimstrFileAsStringstrFile=ThisDrawing.Appli
2、cation.VBE.ActiveVBProject.FileNameSetxcelApp=CreateObject("Excel.Application")xcelApp.Workbooks.OpenLeft$(strFile,Len(strFile)-11)&"test.xlsx",,ReadOnlySetxcelSheet=xcelApp.ActiveWorkbook.Sheets(1)DimmytxtAsAcadTextStyleSetmytxt=ThisDrawing.TextStyles.Add("standard")mytxt.fontFile="c
3、:windowsfontsSIMFANG.TTF"ThisDrawing.ActiveTextStyle=mytxt'Dimnewl,newl1,xxyLine,xxxLineAsAcadSpline'取消顺线路方向Dimnewl,newl1,xxyLineAsAcadSplineDimstartTan(0To2)AsDoubleDimendTan(0To2)AsDoublestartTan(0)=0:startTan(1)=0:startTan(2)=0endTan(0)=0:endTan(1)=0:endTan(2)=0DimptArr(0To92)As
4、DoubleDimptArr1(0To92)AsDoubleDimptArr2(0To92)AsDouble'DimptArr3(0To92)AsDoubleDimi,jAsIntegeri=1j=0DoWhilei<32 ptArr(j)=xcelSheet.Range("C"&i):ptArr(j+1)=xcelSheet.Range("D"&i):ptArr(j+2)=0 ptArr1(j)=xcelSheet.Range("G"&i):ptArr1(j+1)=xcelSheet.Range("H"&i):ptArr1(j+2)=0 ptArr2
5、(j)=xcelSheet.Range("K"&i):ptArr2(j+1)=xcelSheet.Range("L"&i):ptArr2(j+2)=0 'ptArr3(j)=xcelSheet.Range("O"&i):ptArr3(j+1)=xcelSheet.Range("P"&i):ptArr3(j+2)=0 i=i+1 j=j+3LoopSetnewl=ThisDrawing.ModelSpace.AddSpline(ptArr,startTan,endTan)Setnewl1=ThisDrawing.ModelSpace.AddSpline(
6、ptArr1,startTan,endTan)SetxxyLine=ThisDrawing.ModelSpace.AddSpline(ptArr2,startTan,endTan)'SetxxxLine=ThisDrawing.ModelSpace.AddSpline(ptArr3,startTan,endTan)newl.color=acRednewl1.color=acYellowxxyLine.color=acBlue'xxxLine.color=acBlueDimaText,cText,bText,dTextAsAcadTextDimtxtP(0To2)A
7、sDoubletxtP(0)=ptArr(0)+20txtP(1)=ptArr(1)txtP(2)=0SetaText=ThisDrawing.ModelSpace.AddText("A",txtP,800)txtP(0)=ptArr(90)-20txtP(1)=ptArr(91)txtP(2)=0SetcText=ThisDrawing.ModelSpace.AddText("C",txtP,800)txtP(0)=ptArr1(0)+20txtP(1)=ptArr1(1)txtP(2)=0SetbText=ThisDrawing.ModelSpace.AddT
8、ext("
