坐标提取lisp程序

1、坐标提取lisp程序2010-05-1720:50:07|分类：工稈|标签：|字号大中小订阅;该程序主要用于CAD点(point)三维坐标提取，并将数据输出为CASS软件中使用的数据格式输出格式：点号,，测量Y值，测量X值，测量Z值例：1,100.3244,1232,433,25;2010-05-17;命令：plzbsc(defunc:plzbsc()(princn选择所需输出的点(point):)(setqss(ssget);选取坐标点(setqn(sslengthss);计算坐标点数量(setqff(open(getfiled文件保存为f:/dat1)w);保存路径(setqi0)(rep

2、eatn(setqspt(ssnamessi)(setqept(entgetspt)(if(=(cdr(assoc0ept)POINT)(progn(setqlxyz(cdr(assoc10ept)(setqsx(rtos(nth1仪yz);将坐标值实数转换成字符(setqsy(rtos(nth0lxyz)(setqsz(rtos(nth2lxyz)(setqi1(+i1);计算点序号(setqsn(rtosi120);将序号实数转换成字符(setqsxyz(strcatsn,sy,sx,sz)(write-linesxyzff)(setqi(+i1);repeat)(prompt*输出格式(

3、点号,Y，X，Z)*)(prin1)地形图上提取碎步点（高程点）坐标并输出到文本2010-05-1808:50:38|分类：工程|标签：|字号大中小订阅利用程序提取地形图上碎步点的三维坐标。并输出到记事本中，该程序待修改的地方是不能选取点，并输出数据，待改正。(defunc:gcdtq()(setvarcmdecho0);指令执行过程不响应(setqen(entsel选择高程点:);要求碰选一个高程点(setqff(open(getfiled文件保存为f:/txt1)a)(setqen_data(entget(caren);取得元体资料列表(setqpt(cdr(assoc10en_data)

4、;求得高程点坐标pt(setqpy(rtos(nth1pt);提取测量坐标Y值(setqpx(rtos(nth0pt);提取测量坐标X值(setqpz(rtos(nth2pt);提取测量坐标Z值(setqsxyz(strcatpxpypz)(write-linesxyzff)(prin1)(promptn*I!(prin1)连续选取高程点并输出到文本2010-05-1815:33:49|分类：工程|标签：|字号大中小订阅;2010-05-18武赤公路;用于提取地形图中的高程点(碎步点)坐标，同时可以提取点(point)的坐标;本程序的缺点是不能过滤对象，同时也成为了他的优点；没有限制点的样式，

5、块也可以，点也可以；;本程序设计保存文件是可以在已有文件中继续添加数据，但是序号不再累积；这样可以判断不同时期选取的数据(defunc:gcdtq()(setvarcmdecho0);指令执行过程不响应(setqff(open(getfiled文件保存为f:/dat1)a)(setqen(entsel选择高程点:);要求碰选一个高程点(setqi1);生成序号(whileen(setqen_data(entget(caren);取得元体资料列表(setqpt(cdr(assoc10en_data);求得高程点坐标pt(setqpy(rtos(nth1pt);提取测量坐标系Y值(setqpx(r

6、tos(nth0pt);提取测量坐标洗X值(setqpz(rtos(nth2pt);提取测量坐标系Z值(setqpi(rtosi20)(setqpxyz(strcatpi,px,py,pz);输出为CASS数据格式(write-linepxyzff);写入文本(setqen(entseln选择下一个高程点回车结束选择:)(setqi(+i1)(closefile)(prin1)(prompt*从CASS中提取高程点或(point)点坐标，*高程点提取*)(prin1)横断面数据提取(待修改)2010-05-1821:59:09|分类：工程|标签：|字号大中小订阅(defunc:hdm()(se

7、tvarcmdecho0);指令执行过程不响应;计算方位角(setqff(open(getfiled文件保存为c:/hdm1)a)(setqzh(getreal请输入桩号：);计算横断面上点到中心线的垂距，数值分正负(setqpt1(getpointn拾取纵断面上的一点：);用于确定横断面上的零点位置(setqx1(carpt1);给纵断面上一点X赋值x1(setqy1(cadrpt1);给纵断面上一点Y赋值y1(setqpt2(getpointn拾取纵断面上的第二点：);用于确定横断面上的零点位置(setqx2(carpt2);给纵断面上一点X赋值x1(setqy2(cadrpt2);给纵断

8、面上一点Y赋值y1计算纵断面(pt1-pt2)方位角(setqj1(atan(/(-y2y1)(+(-x2x1)0.00000001)(setqj2(/(*j1180)pi)(if(-y2y1)0)(setqsgn1);符号判断(if(=(-y2y1)0)(setqsgn0)(if(-y2y1)0)(setqsgn-1)(setqfwj(+(-180(*90sgn)j2);方位角计算(setqang(/(*fwjpi)180)(setqen(entsel选择高程点:);要求碰选一个高程点(whileen(setqen_data(entget(caren);取得元体资料列表(setqpt(cdr

9、(assoc10en_data);求得高程点坐标pt(setqpy(nth1pt);提取测量坐标系Y值(setqpx(nth0pt);提取测量坐标洗X值(setqpx2(sinang)(setqpx3(cosang)(setqcj(-(*(-pyy1)(cosang)(*(-pxx1)(sinang);计算垂直距离(cj)(setqdist(rtoscj20)(setqpz(rtos(nth2pt)提取测量坐标系Z值(setqpdz(strcatdist,pz);输出为CASS数据格式(write-linepdzff);写入文本(setqen(entseln选择下一个高程点:)(closefi

10、le)(prin1)(prompt*从CASS中提取高程点或(point)点坐标，*C:hdm*输出横断面数据(平距，高程)*)(prin1)批量提取CAD中点(point)三维坐标2010-05-2223:11:43|分类：默认分类|标签：|字号大中小订阅;该程序主要用于CAD点(point)三维坐标提取，并将数据输出为CASS软件中使用的数据格式输出格式：点号,，测量Y值，测量X值，测量Z值例：1,100.3244,1232,433,25;2010-05-17罗泽钢中国葛洲坝集团基础工程有限公司;命令：plzbsc(defunc:plzbsc()(princn选择所需输出的点(point)

11、:)(setqss(ssget);选取坐标点(setqn(sslengthss);计算坐标点数量(setqff(open(getfiled文件保存为f:/dat1)w);保存路径(setqi0)(repeatn(setqspt(ssnamessi)(setqept(entgetspt)(if(=(cdr(assoc0ept)POINT)(progn(setqlxyz(cdr(assoc10ept)(setqsx(rtos(nth1仪yz);将坐标值实数转换成字符(setqsy(rtos(nth0lxyz)(setqsz(rtos(nth2lxyz)(setqi1(+i1);计算点序号(setq

12、sn(rtosi120);将序号实数转换成字符(setqsxyz(strcatsn,sy,sx,sz)(write-linesxyzff)(setqi(+i1);repeat)(prompt*只适合point点*输出格式(点号,Y,X,Z)*)(prin1)从CASS提取高程点坐标输出到文本2010-05-2223:15:18|分类：工程|标签：高程点提取cass|字号大中小订阅:2010-05-17(defunc:gcdtq()(setvarcmdecho0);指令执行过程不响应(setqen(entsel选择高程点:);要求碰选一个高程点(setqff(open(getfiled文件保存为

13、f:/txt1)a)(setqen_data(entget(caren);取得元体资料列表(setqpt(cdr(assoc10en_data);求得高程点坐标pt(setqpy(rtos(nth1pt);提取测量坐标Y值(setqpx(rtos(nth0pt);提取测量坐标X值(setqpz(rtos(nth2pt);提取测量坐标Z值(setqsxyz(strcatpxpypz)(write-linesxyzff)(prin1)(promptn*I!(prin1);修改后可以实现连续提取2011-02-25(defunc:gcdtq()(setvarcmdecho0);指令执行过程不响应(s

14、etqff(open(getfiled文件保存为f:/dat1)a)(setqn0)(while;循环语句(setqen(entseln选择高程点:);要求碰选一个高程点(redraw(caren)3);亮显高程点(setqn(+n1)(setqpn(rtosn20)(setqen_data(entget(caren);取得元体资料列表(setqpt(cdr(assoc10en_data);求得高程点坐标pt(setqpy(rtos(nth1pt);提取测量坐标Y值(setqpx(rtos(nth0pt);提取测量坐标X值(setqpz(rtos(nth2pt);提取测量坐标Z值(setqsx

15、yz(strcatpn,px,py,pz)(write-linesxyzff)(prin1)(princsxyz)(prompt*提取高程点输出为CASS格式*)(prin1);VLISP与EXCEL之间连接及数据传输和函数集2011-05-2908:35:14|分类：工程|标签：|字号大中小订阅*TOC o 1-5 h z333333;DSX-API-Excel.LSP;VisualLISPActiveXAPIforExcel97,2000andXP;Copyright(C)2002DavidM.Stein,Allrightsreserved;*333333;Version2002.2205

16、/15/02:Initialrelease;*333333;CodeprovidedAS-ISwithoutwarrantyofanykindgivenforanypurpose;oruse,eitherexplicitly,implicitlyorasaderivativeworkitem.;UserassumesANYANDALLRISKandLIABILITYforuseofanyofthiscode;foranyconsequentialdamagesofanykind.Thesefunctionsaredefined;withinDSXTools2002.22whenloadedin

17、toAutoCAD.Thisdocumentis;providedforinformationalpurposesonly.;*333333(vl-load-com)*333;MODULE:DSX-TypeLib-Excel;DEscriptION:Returnstypelib(olb)fileforeitherExcel97,2000,orXP;ARGS:none;EXAMPLE:(DSX-TypeLib-Excel)*555(defunDSX-TypeLib-Excel(/sysdrvtlb)(setqsysdrv(getenvsystemdrive)(cond(setqtlb(findf

18、ileOfficeOfficeExcel8.olb)tlb)(setqtlb(findfileOfficeOfficeExcel9.olb)tlb)(setqtlb(findfileOfficeOfficeExcel10.olb)tlb)(setqtlb(findfileOfficeOfficeExcel.exe)tlb)(setqtlb(findfile(strcatsysdrvProgramFilesMicrosoft(strcatsysdrvProgramFilesMicrosoft(strcatsysdrvProgramFilesMicrosoft(strcatsysdrvProgra

19、mFilesMicrosoft(strcatsysdrvProgramFilesMicrosoftOfficeOffice10Excel.exe)tlb)*555;MODULE:DSX-Load-TypeLib-Excel;DEscriptION:LoadstypelibforExcel97,2000orXP(whicheverisfound);ARGS:none;EXAMPLE:(DSX-Load-TypeLib-Excel)*555(defunDSX-Load-TypeLib-Excel(/tlbfiletlbverout)(dsx-princn(DSX-Load-TypeLib-Exce

20、l)(cond(nullmsxl-xl24HourClock)(if(setqtlbfile(DSX-TypeLib-Excel)(progn(setqtlbver(substr(vl-filename-basetlbfile)6)(cond(=tlbver9)(princnInitializingMicrosoftExcel2000.)(=tlbver8)(princnInitializingMicrosoftExcel97.)(=(vl-filename-basetlbfile)Excel.exe)(princnInitializingMicrosoftExcelXP.)(vlax-imp

21、ort-type-library:tlb-filenametlbfile:methods-prefixmsxl-:properties-prefixmsxl-:constants-prefixmsxl-)(ifmsxl-xl24HourClock(setqoutT)(T(setqoutT)out)*555;MODULE:DSX-Open-Excel-New;DEscriptION:OpensanewsessionofExcel97,2000orXP;ARGS:display-mode(SHOWorHIDE);EXAMPLE:(setqxlapp(DSX-Open-Excel-NewSHOW)*

22、555(defunDSX-Open-Excel-New(dmode/appsession)(dsx-princn(DSX-Open-Excel-New)(princnCreatingnewExcelSpreadsheetfile.)(cond(setqappsession(vlax-create-objectExcel.Application)(vlax-invoke-method(vlax-get-propertyappsessionWorkBooks)Add)(if(=(strcasedmode)SHOW)(vla-put-visibleappsession1)(vla-put-visib

23、leappsession0)appsession)*555;MODULE:DSX-Open-Excel-Exist;DEscriptION:Getshandletoexisting(running)sessionofExcel97,2000,XP;ARGS:xls-filename,display-mode(SHOWorHIDE);EXAMPLE:(setqxlapp(DSX-Open-Excel-Existmyfile.xlsSHOW)*555(defunDSX-Open-Excel-Exist(xfiledmode/appsession)(dsx-princn(DSX-Open-Excel

24、-Exist)(princnOpeningExcelSpreadsheetfile.)(cond(setqfn(findfilexfile)(cond(setqappsession(vlax-get-or-create-objectExcel.Application)(vlax-invoke-method(vlax-get-propertyappsessionWorkBooks)Openfn)(if(=(strcasedmode)SHOW)(vla-put-visibleappsession1)(vla-put-visibleappsession0)(T(alert(strcatnCannot

25、locatesourcefile:xfile)appsession)*555;MODULE:DSX-Excel-Put-ColumnList;DEscriptION:Writeeachlistmembertoacolumn(startcol)startingatrow(startrow);ARGS:list,startrow,startcol;EXAMPLE:(DSX-Excel-Put-ColumnList(ABC)12)putsmembersintocells(1,B)(2,B)(3,B)respectively*555(defunDSX-Excel-Put-ColumnList(lsts

26、tartrowstartcol)(dsx-princn(DSX-Excel-Put-ColumnList)(foreachitmlst(msxl-put-value(DSX-Excel-Get-Cellrangestartrowstartcol)itm)(setqstartrow(1+startrow);repeat)*555;MODULE:DSX-Excel-Put-RowList;DEscriptION:Writeeachlistmembertorow(startrow)startingatcolumn(startcol);ARGS:list,startrow,startcol;EXAMP

27、LE:(DSX-Excel-Put-RowList(ABC)21)putsmembersintocells(1,B)(1,C)(1,D)respectively*555(defunDSX-Excel-Put-RowList(lststartrowstartcol)(dsx-princn(DSX-Excel-Put-RowList)(foreachitmlst(msxl-put-value(DSX-Excel-Get-Cellrangestartrowstartcol)itm)(setqstartcol(1+startcol);repeat)*555;MODULE:DSX-Excel-Put-C

28、ellColor;DEscriptION:Appliesfill-colortospecifiedcell;ARGS:row,column,color(integer);EXAMPLE:(DSX-Excel-Put-CellColor1114)applycolor#14tocell(1,A)*555(defunDSX-Excel-Put-CellColor(rowcolintcol/rng)(setqrng(DSX-Excel-Get-Cell(msxl-get-ActiveSheetxlapp)rowcol)(msxl-put-colorindex(msxl-get-interiorrng)

29、intcol)*555;MODULE:DSX-Excel-Put-RowCellsColor;DEscriptION:Appliesfill-colortoarowofcells;ARGS:startrow,startcol,num-cols,color(integer);EXAMPLE:(DSX-Excel-Put-RowCellsColor11514)Startatrow=1col=1repeatfor5columnsusingcolor#14*(defunDSX-Excel-Put-RowCellsColor(startrowstartcolcolsintcol/next)(dsx-pr

30、incn(DSX-Excel-Put-RowCellsColor)(setqnextstartcol)(repeatcols(DSX-Excel-Put-CellColorstartrownextintcol)(setqnext(1+next)*555;MODULE:DSX-Excel-Put-ColumnCellsColor;DEscriptION:Changefillcolorinacolumnofcells;ARGS:startrow,startcol,num-rows,color(integer);EXAMPLE:(DSX-Excel-Put-ColumnCellsColor11514

31、)Startatrow=1col=1repeatfor5rowsusingcolor#14*555(defunDSX-Excel-Put-ColumnCellsColor(startrowstartcolrowsintcol/next)(dsx-princn(DSX-Excel-Put-ColumnCellsColor)(setqnextstartrow)(repeatrows(DSX-Excel-Put-CellColornextstartcolintcol)(setqnext(1+next)*555;MODULE:DSX-Excel-Get-Cell;DEscriptION:Getcell

32、objectrelativetorangeusing(relrow)and(relcol)offsets;ARGS:range-object,relative-row,relative-col;EXAMPLE:(DSX-Excel-Get-Cellrng122)*555(defunDSX-Excel-Get-Cell(rngrelrowrelcol)(dsx-princn(DSX-Excel-Get-Cell)(vlax-variant-value(msxl-get-item(msxl-get-cellsrng)(vlax-make-variantrelrow)(vlax-make-varia

33、ntrelcol)*555;MODULE:DSX-Excel-Get-CellValue;DEscriptION:Returnvalueingivencell(row,column)ofactivesessionobject(xlapp);ARGS:row(int),column(int);EXAMPLE:(DSX-Excel-Get-CellValue12)*555(defunDSX-Excel-Get-CellValue(rowcol)(dsx-princn(DSX-Excel-Get-CellValue)(vlax-variant-value(msxl-get-value(DSX-Exc

34、el-Get-Cell(msxl-get-ActiveSheetxlapp)rowcol)*555;MODULE:DSX-Excel-Get-RowValues;DEscriptION:Returnsalistofcellvalueswithinagivenrow;ARGS:row-number(int),startcol,num-cells;EXAMPLE:(DSX-Excel-Get-RowValues3120)getfirst20valuesinrow3*555(defunDSX-Excel-Get-RowValues(rowstartcolnumcells/nextout)(dsx-p

35、rincn(DSX-Excel-Get-RowValues)(setqnextstartcol)(repeatnumcells(setqout(ifout(appendout(list(DSX-Excel-Get-CellValuerownext);rowxcol(list(DSX-Excel-Get-CellValuerownext);rowxcol)next(1+next);repeatout)*555;MODULE:DSX-Excel-Get-ColumnValues;DEscriptION:Returnsalistofcellvalueswithinagivencolumn;ARGS:

36、column-number(int),startrow,num-cells;EXAMPLE:(DSX-Excel-Get-ColumnValues2120)gettop-20entriesincolumn2(B)*555(defunDSX-Excel-Get-ColumnValues(colstartrownumcells/nextout)(dsx-princn(DSX-Excel-Get-ColumnValues)(setqnextstartrow)(repeatnumcells(setqout(ifout(appendout(list(DSX-Excel-Get-CellValuenext

37、col)(list(DSX-Excel-Get-CellValuenextcol)next(1+next);repeatout)*555;MODULE:DSX-Excel-GetRangeValues-ByRows;DEscriptION:Getrangevaluesinroworderandreturnasnestedlists;ARGS:startrow,startcol,num-rows,num-cols;EXAMPLE:(DSX-Excel-GetRangeValues-ByRows11510)getrangevaluesfrom1Ato5Jwhereeachsublistisoner

38、ow*555(defunDSX-Excel-GetRangeValues-ByRows(startrowstartcolnumrowsnumcols/nextrowrowlstoutlst)(dsx-princn(DSX-Excel-GetRangeValues-ByRows)(setqnextrowstartrow)(repeatnumrows(setqrowlst(DSX-Excel-Get-RowValuesnextrowstartcolnumcols)outlst(ifoutlst(appendoutlst(listrowlst)(listrowlst)nextrow(1+nextrow)outlst)*555;MODULE:DSX-Excel-GetRange