本文格式為Word版，下載可任意編輯——坐標提取lisp程序坐標提取lisp程序

2023-05-1720:50:07|分類：工程|標簽：|字號大中小訂閱

;該程序主要用于CAD點（point）三維坐標提取，并將數(shù)據(jù)輸出為CASS軟件中使用的數(shù)據(jù)格式;輸出格式：點號,,測量Y值，測量X值，測量Z值例：1,,100.3244,1232,433,25;2023-05-17;命令：plzbsc(defunc:plzbsc()

(princ\選擇所需輸出的點（point）:\(setqss(ssget));;選取坐標點(setqn(sslengthss));計算坐標點數(shù)量

(setqff(open(getfiled\文件保存為\保存路徑(setqi0)(repeatn

(setqspt(ssnamessi))(setqept(entgetspt))

(if(=(cdr(assoc0ept))\(progn(setqlxyz(cdr(assoc10ept)))(setqsx(rtos(nth1lxyz)));將坐標值實數(shù)轉(zhuǎn)換成字符(setqsy(rtos(nth0lxyz)))(setqsz(rtos(nth2lxyz)))(setqi1(+i1));計算點序號(setqsn(rtosi120));將序號實數(shù)轉(zhuǎn)換成字符(setqsxyz(strcatsn\sy\sx\sz))(write-linesxyzff)))

(setqi(+i1)));repeat)

(prompt\命令:plzbsc>>*輸出格式（點號,,Y，X，Z）**\(prin1)

地形圖上提取碎步點（高程點）坐標并輸出到文本

2023-05-1808:50:38|分類：工程|標簽：|字號大中小訂閱利用程序提取地形圖上碎步點的三維坐標。并輸出到記事本中，

該程序待修改的地方是不能選取點，并輸出數(shù)據(jù)，待改正。(defunc:gcdtq()

(setvar\指令執(zhí)行過程不響應(yīng)

(setqen(entsel\選擇高程點:\要求碰選一個高程點(setqff(open(getfiled\文件保存為\(setqen_data(entget(caren)));取得元體資料列表(setqpt(cdr(assoc10en_data)));求得高程點坐標pt(setqpy(rtos(nth1pt)));提取測量坐標Y值(setqpx(rtos(nth0pt)));提取測量坐標X值(setqpz(rtos(nth2pt)));提取測量坐標Z值(setqsxyz(strcatpx\\py\\pz))(write-linesxyzff)(prin1))

(prompt\(prin1)

連續(xù)選取高程點并輸出到文本

2023-05-1815:33:49|分類：工程|標簽：|字號大中小訂閱;2023-05-18武赤馬路

;用于提取地形圖中的高程點（碎步點）坐標，同時可以提取點（point）的坐標

;本程序的缺點是不能過濾對象，同時也成為了他的優(yōu)點；沒有限制點的樣式，塊也可以，點也可以；;本程序設(shè)計保存文件是可以在已有文件中繼續(xù)添加數(shù)據(jù)，但是序號不再累積；這樣可以判斷不同時期選取的數(shù)據(jù)

(defunc:gcdtq()

(setvar\指令執(zhí)行過程不響應(yīng)

(setqff(open(getfiled\文件保存為\(setqen(entsel\選擇高程點:\要求碰選一個高程點(setqi1);生成序號(whileen

(setqen_data(entget(caren)));取得元體資料列表(setqpt(cdr(assoc10en_data)));求得高程點坐標pt(setqpy(rtos(nth1pt)));提取測量坐標系Y值(setqpx(rtos(nth0pt)));提取測量坐標洗X值(setqpz(rtos(nth2pt)));提取測量坐標系Z值(setqpi(rtosi20))

(setqpxyz(strcatpi\py\pz));輸出為CASS數(shù)據(jù)格式(write-linepxyzff);寫入文本

(setqen(entsel\選擇下一個高程點:\

(setqi(+i1)))

(closefile)(prin1))

(prompt\從CASS中提取高程點或（point）點坐標，*>*高程點提取**\(prin1)

橫斷面數(shù)據(jù)提?。ù薷模?/p>

2023-05-1821:59:09|分類：工程|標簽：|字號大中小訂閱(defunc:hdm()

(setvar\指令執(zhí)行過程不響應(yīng);計算方位角

(setqff(open(getfiled\文件保存為\(setqzh(getreal\請輸入樁號：\

;計算橫斷面上點到中心線的垂距，數(shù)值分正負

(setqpt1(getpoint\拾取縱斷面上的一點：\用于確定橫斷面上的零點位置(setqx1(carpt1));給縱斷面上一點X賦值x1(setqy1(cadrpt1));給縱斷面上一點Y賦值y1

(setqpt2(getpoint\拾取縱斷面上的其次點：\用于確定橫斷面上的零點位置(setqx2(carpt2));給縱斷面上一點X賦值x1(setqy2(cadrpt2));給縱斷面上一點Y賦值y1;計算縱斷面（pt1->pt2）方位角

(setqj1(atan(/(-y2y1)(+(-x2x1)0.00000001)))))(setqj2(/(*j1180)pi))

(if(>(-y2y1)0)(setqsgn1));符號判斷(if(=(-y2y1)0)(setqsgn0))(if(:\)

(closefile)(prin1))

(prompt\從CASS中提取高程點或（point）點坐標，*>*輸出橫斷面數(shù)據(jù)（平距，高程）**\(prin1)

批量提取CAD中點（point）三維坐標

2023-05-2223:11:43|分類：默認分類|標簽：|字號大中小訂閱

;該程序主要用于CAD點（point）三維坐標提取，并將數(shù)據(jù)輸出為CASS軟件中使用的數(shù)據(jù)格式;輸出格式：點號,,測量Y值，測量X值，測量Z值例：1,,100.3244,1232,433,25;2023-05-17羅澤鋼中國葛洲壩集團基礎(chǔ)工程有限公司;命令：plzbsc(defunc:plzbsc()

(princ\選擇所需輸出的點（point）:\(setqss(ssget));;選取坐標點(setqn(sslengthss));計算坐標點數(shù)量

(setqff(open(getfiled\文件保存為\保存路徑(setqi0)(repeatn

(setqspt(ssnamessi))(setqept(entgetspt))

(if(=(cdr(assoc0ept))\(progn(setqlxyz(cdr(assoc10ept)))(setqsx(rtos(nth1lxyz)));將坐標值實數(shù)轉(zhuǎn)換成字符(setqsy(rtos(nth0lxyz)))(setqsz(rtos(nth2lxyz)))(setqi1(+i1));計算點序號(setqsn(rtosi120));將序號實數(shù)轉(zhuǎn)換成字符(setqsxyz(strcatsn\sy\sx\sz))

(write-linesxyzff)))

(setqi(+i1)));repeat)

(prompt\只適合point點>*輸出格式（點號,,Y，X，Z）**\(prin1)

從CASS提取高程點坐標輸出到文本

2023-05-2223:15:18|分類：工程|標簽：高程點提取cass|字號大中小訂閱:2023-05-17(defunc:gcdtq()

(setvar\指令執(zhí)行過程不響應(yīng)

(setqen(entsel\選擇高程點:\要求碰選一個高程點(setqff(open(getfiled\文件保存為\(setqen_data(entget(caren)));取得元體資料列表(setqpt(cdr(assoc10en_data)));求得高程點坐標pt(setqpy(rtos(nth1pt)));提取測量坐標Y值(setqpx(rtos(nth0pt)));提取測量坐標X值(setqpz(rtos(nth2pt)));提取測量坐標Z值(setqsxyz(strcatpx\\py\\pz))(write-linesxyzff)(prin1))

(prompt\(prin1);

修改后可以實現(xiàn)連續(xù)提取2023--02--25(defunc:gcdtq()

(setvar\指令執(zhí)行過程不響應(yīng)

(setqff(open(getfiled\文件保存為\(setqn0)(while;循環(huán)語句

(setqen(entsel\選擇高程點:\要求碰選一個高程點(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值(setqsxyz(strcatpn\py\pz))(write-linesxyzff)(prin1)(princsxyz)))

(prompt\提取高程點輸出為CASS格式****\(prin1);

VLISP與EXCEL之間連接及數(shù)據(jù)傳輸和函數(shù)集

2023-05-2908:35:14|分類：工程|標簽：|字號大中小訂閱

;;;*************************************************************************;;;;;;DSX-API-Excel.LSP;;;

;;;VisualLISPActiveXAPIforExcel97,2000andXP;;;;;;Copyright(C)2023DavidM.Stein,Allrightsreserved;;;;;;*************************************************************************;;;;;;Version2023.2205/15/02:Initialrelease;;;;;;*************************************************************************;;;

;;;CodeprovidedAS-ISwithoutwarrantyofanykindgivenforanypurpose;;;;;;oruse,eitherexplicitly,implicitlyorasaderivativeworkitem.;;;

;;;UserassumesANYANDALLRISKandLIABILITYforuseofanyofthiscode;;;

;;;foranyconsequentialdamagesofanykind.Thesefunctionsaredefined;;;;;;withinDSXTools2023.22whenloadedintoAutoCAD.Thisdocumentis;;;

;;;providedforinformationalpurposesonly.;;;;;;*************************************************************************;;;(vl-load-com)

;;;*************************************************************************;;;MODULE:DSX-TypeLib-Excel

;;;DEscriptION:Returnstypelib(olb)fileforeitherExcel97,2000,orXP;;;ARGS:none

;;;EXAMPLE:(DSX-TypeLib-Excel)

;;;*************************************************************************

(defunDSX-TypeLib-Excel(/sysdrvtlb)(setqsysdrv(getenv\(cond

((setqtlb(findfile(strcatsysdrv\Files\\\\MicrosoftOffice\\\\Office\\\\Excel8.olb\tlb)

((setqtlb(findfile(strcatsysdrv\Files\\\\MicrosoftOffice\\\\Office\\\\Excel9.olb\tlb)

((setqtlb(findfile(strcatsysdrv\Files\\\\MicrosoftOffice\\\\Office\\\\Excel10.olb\tlb)

((setqtlb(findfile(strcatsysdrv\Files\\\\MicrosoftOffice\\\\Office\\\\Excel.exe\tlb)

((setqtlb(findfile(strcatsysdrv\Files\\\\MicrosoftOffice\\\\Office10\\\\Excel.exe\tlb)))

;;;*************************************************************************;;;MODULE:DSX-Load-TypeLib-Excel

;;;DEscriptION:LoadstypelibforExcel97,2000orXP(whicheverisfound);;;ARGS:none

;;;EXAMPLE:(DSX-Load-TypeLib-Excel)

;;;*************************************************************************(defunDSX-Load-TypeLib-Excel(/tlbfiletlbverout)(dsx-princ\(cond

((nullmsxl-xl24HourClock)

(if(setqtlbfile(DSX-TypeLib-Excel))(progn

(setqtlbver(substr(vl-filename-basetlbfile)6))(cond

((=tlbver\(princ\

((=tlbver\(princ\((=(vl-filename-basetlbfile)\(princ\))

(vlax-import-type-library:tlb-filenametlbfile:methods-prefix\:properties-prefix\:constants-prefix\)

(ifmsxl-xl24HourClock(setqoutT)))))

(T(setqoutT)))out)

;;;*************************************************************************;;;MODULE:DSX-Open-Excel-New

;;;DEscriptION:OpensanewsessionofExcel97,2000orXP;;;ARGS:display-mode(\

;;;EXAMPLE:(setqxlapp(DSX-Open-Excel-New\

;;;*************************************************************************(defunDSX-Open-Excel-New(dmode/appsession)(dsx-princ\

(princ\(cond

((setqappsession(vlax-create-object\(vlax-invoke-method

(vlax-get-propertyappsession'WorkBooks)'Add)

(if(=(strcasedmode)\(vla-put-visibleappsession1)(vla-put-visibleappsession0))))

appsession)

;;;*************************************************************************;;;MODULE:DSX-Open-Excel-Exist

;;;DEscriptION:Getshandletoexisting(running)sessionofExcel97,2000,XP

;;;ARGS:xls-filename,display-mode(\

;;;EXAMPLE:(setqxlapp(DSX-Open-Excel-Exist\;;;*************************************************************************(defunDSX-Open-Excel-Exist(xfiledmode/appsession)(dsx-princ\(princ\(cond

((setqfn(findfilexfile))(cond

((setqappsession(vlax-get-or-create-object\(vlax-invoke-method

(vlax-get-propertyappsession'WorkBooks)'Openfn)

(if(=(strcasedmode)\(vla-put-visibleappsession1)(vla-put-visibleappsession0)))))

(T(alert(strcat\)

appsession)

;;;*************************************************************************;;;MODULE:DSX-Excel-Put-ColumnList

;;;DEscriptION:Writeeachlistmembertoacolumn(startcol)startingatrow(startrow)

;;;ARGS:list,startrow,startcol

;;;EXAMPLE:(DSX-Excel-Put-ColumnList'(\membersintocells(1,B)(2,B)(3,B)respectively

;;;*************************************************************************(defunDSX-Excel-Put-ColumnList(lststartrowstartcol)(dsx-princ\(foreachitmlst(msxl-put-value

(DSX-Excel-Get-Cellrangestartrowstartcol)itm

)

(setqstartrow(1+startrow)));repeat)

;;;*************************************************************************;;;MODULE:DSX-Excel-Put-RowList

;;;DEscriptION:Writeeachlistmembertorow(startrow)startingatcolumn(startcol)

;;;ARGS:list,startrow,startcol

;;;EXAMPLE:(DSX-Excel-Put-RowList'(\cells(1,B)(1,C)(1,D)respectively

;;;*************************************************************************(defunDSX-Excel-Put-RowList(lststartrowstartcol)(dsx-princ\(foreachitmlst(msxl-put-value

(DSX-Excel-Get-Cellrangestartrowstartcol)itm)

(setqstartcol(1+startcol)));repeat)

;;;*************************************************************************;;;MODULE:DSX-Excel-Put-CellColor

;;;DEscriptION:Appliesfill-colortospecifiedcell;;;ARGS:row,column,color(integer)

;;;EXAMPLE:(DSX-Excel-Put-CellColor1114)applycolor#14tocell(1,A);;;*************************************************************************(defunDSX-Excel-Put-CellColor(rowcolintcol/rng)

(setqrng(DSX-Excel-Get-Cell(msxl-get-ActiveSheetxlapp)rowcol))(msxl-put-colorindex(msxl-get-interiorrng)intcol))

;;;*************************************************************************;;;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-princ\

(setqnextstartcol)(repeatcols

(DSX-Excel-Put-CellColorstartrownextintcol)(setqnext(1+next))))

;;;*************************************************************************;;;MODULE:DSX-Excel-Put-ColumnCellsColor

;;;DEscriptION:Changefillcolorinacolumnofcells;;;ARGS:startrow,startcol,num-rows,color(integer)

;;;EXAMPLE:(DSX-Excel-Put-ColumnCellsColor11514)Startatrow=1col=1repeatfor5rowsusingcolor#14

;;;*************************************************************************(defunDSX-Excel-Put-ColumnCellsColor(startrowstartcolrowsintcol/next)

(dsx-princ\(setqnextstartrow)(repeatrows

(DSX-Excel-Put-CellColornextstartcolintcol)(setqnext(1+next))))

;;;*************************************************************************;;;MODULE:DSX-Excel-Get-Cell

;;;DEscriptION:Getcellobjectrelativetorangeusing(relrow)and(relcol)offsets

;;;ARGS:range-object,relative-row,relative-col;;;EXAMPLE:(DSX-Excel-Get-Cellrng122)

;;;*************************************************************************(defunDSX-Excel-Get-Cell(rngrelrowrelcol)(dsx-princ\(vlax-variant-value

(msxl-get-item(msxl-get-cellsrng)(vlax-make-variantrelrow)(vlax-make-variantrelcol))))

;;;*************************************************************************;;;MODULE:DSX-Excel-Get-CellValue

;;;DEscriptION:Returnvalueingivencell(row,column)ofactivesessionobject(xlapp)

;;;ARGS:row(int),column(int)

;;;EXAMPLE:(DSX-Excel-Get-CellValue12)

;;;*************************************************************************(defunDSX-Excel-Get-CellValue(rowcol)(dsx-princ\(vlax-variant-value(msxl-get-value

(DSX-Excel-Get-Cell

(msxl-get-ActiveSheetxlapp)rowcol))))

;;;*************************************************************************;;;MODULE:DSX-Excel-Get-RowValues

;;;DEscriptION:Returnsalistofcellvalueswithinagivenrow;;;ARGS:row-number(int),startcol,num-cells

;;;EXAMPLE:(DSX-Excel-Get-RowValues3120)getfirst20valuesinrow3;;;*************************************************************************(defunDSX-Excel-Get-RowValues(rowstartcolnumcells/nextout)

(dsx-princ\

(setqnextstartcol)(repeatnumcells(setqout(ifout(appendout(list(DSX-Excel-Get-CellValuerownext)));rowxcol(list(DSX-Excel-Get-CellValuerownext));rowxcol)

next(1+next))

);repeatout)

;;;*************************************************************************;;;MODULE:DSX-Excel-Get-ColumnValues

;;;DEscriptION:Returnsalistofcellvalueswithinagivencolumn

;;;ARGS:column-number(int),startrow,num-cells

;;;EXAMPLE:(DSX-Excel-Get-ColumnValues2120)gettop-20entriesincolumn2(\

;;;*************************************************************************(defunDSX-Excel-Get-ColumnValues(colstartrownumcells/nextout)

(dsx-princ\

(setqnextstartrow)(repeatnumcells(setqout(ifout

(appendout(list(DSX-Excel-Get-CellValuenextcol)))(list(DSX-Excel-Get-CellValuenextcol)))

next(1+next))

);repeatout)

;;;*************************************************************************;;;MODULE:DSX-Excel-GetRangeValues-ByRows

;;;DEscriptION:Getrangevaluesinroworderandreturnasnestedlists;;;ARGS:startrow,startcol,num-rows,num-cols

;;;EXAMPLE:(DSX-Excel-GetRangeValues-ByRows11510)getrangevaluesfrom1Ato5Jwhereeachsublistisonerow

;;;*************************************************************************(defunDSX-Excel-GetRangeValues-ByRows

(startrowstartcolnumrowsnumcols/nextrowrowlstoutlst)(dsx-princ\(setqnextrowstartrow)(repeatnumrows

(setqrowlst(DSX-Excel-Get-RowValuesnextrowstartcolnumcols)outlst(ifoutlst(appendoutlst(listrowlst))(listrowlst))nextrow(1+nextrow)))

outlst)

;;;*************************************************************************;;;MODULE:DSX-Excel-GetRangeValues-ByCols

;;;DEscriptION:Getrangevaluesincolumnorderandreturnasnestedlists;;;ARGS:startrow,startcol,num-rows,num-cols

;;;EXAMPLE:(DSX-Excel-GetRangeValues-ByCols11510)getrangevaluesfrom1Ato5Jwhereeachsublistisonecolumn

;;;*************************************************************************

(defunDSX-Excel-GetRangeValues-ByCols

(startrowstartcolnumrowsnumcols/nextrownextcolcollstoutlst)(dsx-princ\(setqnextcolstartcol)(repeatnumcols

(setqcollst(DSX-Excel-Get-ColumnValuesnextcolstartrownumrows)outlst(ifoutlst(appendoutlst(listcollst))(listcollst))nextcol(1+nextcol)))

outlst)

;;;*************************************************************************;;;MODULE:DSX-Excel-Get-ActiveWorkSheet

;;;DEscriptION:ReturnsobjectofactiveworksheetinactiveExcelsession;;;ARGS:app(sessionobject)

;;;EXAMPLE:(DSX-Excel-Get-ActiveWorkSheetxlapp)

;;;*************************************************************************(defunDSX-Excel-Get-ActiveWorkSheet(xlapp)(dsx-princ\(msxl-get-ActiveSheetxlapp))

;;;*************************************************************************;;;MODULE:DSX-Excel-RangeAutoFit

;;;DEscriptION:AppliesAuto-Fittocolumnswithinactiverange;;;ARGS:active-sheet(object)

;;;EXAMPLE:(DSX-Excel-RangeAutoFitmyxlws)

;;;*************************************************************************(defunDSX-Excel-RangeAutoFit(active-sheet)(dsx-princ\(vlax-invoke-method(vlax-get-property(vlax-get-property

(vlax-get-propertyactive-sheet'UsedRange)'Cells)

'Columns)

'AutoFit

))

(defunDSX-Excel-RangeDataFormat(active-sheet)(dsx-princ\(vlax-put-property

(vlax-get-propertyactive-sheet\'NumberFormat\))

;;;*************************************************************************;;;MODULE:DSX-Excel-Quit

;;;DEscriptION:QuitandcloseExcelsession(app);;;ARGS:app(sessionobject)

;;;EXAMPLE:(DSX-Excel-Quitxlapp)

;;;*************************************************************************(defunDSX-Excel-Quit(appsession)(dsx-princ\(cond

((not(vlax-object-released-pappsession))(vlax-invoke-methodappsession'QUIT)(vlax-release-objectappsession))))

;;;*************************************************************************;;;MODULE:DSX-Excel-Kill

;;;DEscriptION:ForcesanyopenExcelsessionstobeclosed;;;ARGS:none

;;;EXAMPLE:(DSX-Excel-Kill)

;;;*************************************************************************(defunDSX-Excel-Kill(/eo)

(while(setqeo(vlax-get-object\(DSX-Excel-Quiteo)(vlax-release-objecteo)(setqeonil)

(gc)(gc);;eventhisdoesn'talwayskillthedamnthing!))

;;;*************************************************************************;;;MODULE:;;;DEscriptION:

;;;ARGS:;;;EXAMPLE:

;;;*************************************************************************;;;Removetrailing'nil'membersfromagivenlist(defunDSX-TrimList(lst)(cond

((/=nil(lastlst))lst)(T

(DSX-TrimList(reverse(cdr(reverselst)))))))

;;;*************************************************************************;;;MODULE:;;;DEscriptION:;;;ARGS:;;;EXAMPLE:

;;;*************************************************************************;;;Convertalistofvaluesintoalistofstringequivalents(defunDSX-ListStr(lst/mbrout)(setqout'())(foreachmbrlst(cond

((=mbrnil)(setqout(cons\((=(typembr)'STR)

(if(membermbr'(\\\(setqout(cons\

(setqout(consmbrout))))

((=(typembr)'INT)(setqout(cons(itoambr)out)))

((=(typembr)'REAL)(setqout(cons(rtosmbr26)out)))))

(reverseout))

;;;*************************************************************************;;;MODULE:DSX-Excel-Sheets

;;;DEscriptION:ReturnsSHEETScollectionfromactiveworkbook;;;ARGS:Excel-application

;;;EXAMPLE:(setqsheets(DSX-Excel-SheetsxlApp))

;;;*************************************************************************

(defunDSX-Excel-Sheets(xlapp)

(setqxlsheets(vlax-get-propertyxlapp\)

;;;*************************************************************************;;;MODULE:DSX-Excel-SheetDelete

;;;DEscriptION:Deletesheet(tab)fromactiveworkbooksheetscollection;;;ARG:sheet-name,sheets-collection

;;;EXAMPLE:(DSX-Excel-SheetDelete\

;;;*************************************************************************(defunDSX-Excel-SheetDelete(namexlsheets)(vlax-forshxlsheets

(if(=(vlax-get-propertysh\(vlax-invoke-methodsh\)))

;;;*************************************************************************;;;MODULE:DSX-Excel-SheetAdd

;;;DEscriptION:Addnewsheet(tab)tosheetscollectioninworkbook,returnssheetobject

;;;ARG:sheet-name,sheets-collection

;;;EXAMPLE:(setqnewsheet(DSX-Excel-SheetAdd\;;;*************************************************************************(defunDSX-Excel-SheetAdd(namexlsheets)

(setqnewsheet(vlax-invoke-methodxlsheets\(vlax-put-propertynewsheet\newsheet)

;;;*************************************************************************;;;MODULE:DSX-Excel-WorkbookSave

;;;DEscriptION:Savesactiv