坐标提取lisp程序[共13页]

《坐标提取lisp程序[共13页]》由会员分享，可在线阅读，更多相关《坐标提取lisp程序[共13页]（13页珍藏版）》请在装配图网上搜索。

1、坐标提取lisp程序2010-05-17 20:50:07|分类： 工程 |标签： |字号大中小订阅 ;该程序主要用于CAD点（point）三维坐标提取,并将数据输出为CASS软件中使用的数据格式;输出格式： 点号,测量Y值,测量X值,测量Z值 例：1,100.3244,1232,433,25;2010-05-17 ;命令：plzbsc(defun c:plzbsc() (princ n选择所需输出的点（point）:) (setq ss (ssget );选取坐标点 (setq n (sslength ss );计算坐标点数量 (setq ff (open (getfiled 文件保存为 f

2、:/ dat 1) w);保存路径 (setq i 0) (repeat n(setq spt (ssname ss i ) (setq ept (entget spt) (if (= (cdr (assoc 0 ept) POINT) (progn (setq lxyz (cdr (assoc 10 ept) (setq sx (rtos (nth 1 lxyz);将坐标值实数转换成字符 (setq sy (rtos (nth 0 lxyz) (setq sz (rtos (nth 2 lxyz) (setq i1 (+ i 1);计算点序号 (setq sn (rtos i1 2 0);将

3、序号实数转换成字符 (setq sxyz (strcat sn, sy , sx , sz) (write-line sxyz ff) ) (setq i (+ i 1) );repeat)(prompt * *输出格式（点号, Y,X,Z）*)(prin1)地形图上提取碎步点（高程点）坐标并输出到文本2010-05-18 08:50:38|分类： 工程 |标签： |字号大中小订阅 利用程序提取地形图上碎步点的三维坐标。并输出到记事本中,该程序待修改的地方是不能选取点,并输出数据,待改正。(defun c:gcdtq()(setvar cmdecho 0) ;指令执行过程不响应(setq en

4、 (entsel 选择高程点:) ;要求碰选一个高程点(setq ff (open (getfiled 文件保存为 f:/ txt 1) a)(setq en_data (entget (car en) ;取得元体资料列表(setq pt (cdr (assoc 10 en_data) ;求得高程点坐标pt(setq py(rtos (nth 1 pt);提取测量坐标Y值(setq px(rtos (nth 0 pt);提取测量坐标X值(setq pz(rtos (nth 2 pt);提取测量坐标Z值(setq sxyz (strcat px py pz)(write-line sxyz ff

5、)(prin1)(prompt * *)(prin1)连续选取高程点并输出到文本2010-05-18 15:33:49|分类： 工程 |标签： |字号大中小订阅 ;2010-05-18 武赤公路;用于提取地形图中的高程点（碎步点）坐标,同时可以提取点（point）的坐标;本程序的缺点是不能过滤对象,同时也成为了他的优点；没有限制点的样式,块也可以,点也可以；;本程序设计保存文件是可以在已有文件中继续添加数据,但是序号不再累积；这样可以判断不同时期选取的数据(defun c:gcdtq()(setvar cmdecho 0) ;指令执行过程不响应(setq ff (open (getfiled

6、文件保存为 f:/ dat 1) a)(setq en (entsel 选择高程点:);要求碰选一个高程点(setq i 1);生成序号(while en(setq en_data (entget (car en) ;取得元体资料列表(setq pt (cdr (assoc 10 en_data) ;求得高程点坐标pt(setq py(rtos (nth 1 pt);提取测量坐标系Y值(setq px(rtos (nth 0 pt);提取测量坐标洗X值(setq pz(rtos (nth 2 pt);提取测量坐标系Z值(setq pi(rtos i 2 0)(setq pxyz (strcat

7、 pi, px , py , pz);输出为CASS数据格式(write-line pxyz ff);写入文本(setq en (entsel n选择下一个高程点:)(setq i (+ i 1)(close file)(prin1)(prompt *从CASS中提取高程点或（point）点坐标,* *高程点提取*)(prin1)横断面数据提取（待修改）2010-05-18 21:59:09|分类： 工程 |标签： |字号大中小订阅 (defun c:hdm()(setvar cmdecho 0) ;指令执行过程不响应;计算方位角(setq ff (open (getfiled 文件保存为 c

8、:/ hdm 1) a)(setq zh (getreal请输入桩号：);计算横断面上点到中心线的垂距,数值分正负(setq pt1 (getpoint n拾取纵断面上的一点：);用于确定横断面上的零点位置(setq x1 (car pt1);给纵断面上一点X赋值x1(setq y1 (cadr pt1);给纵断面上一点Y赋值y1(setq pt2 (getpoint n拾取纵断面上的第二点：);用于确定横断面上的零点位置(setq x2 (car pt2);给纵断面上一点X赋值x1(setq y2 (cadr pt2);给纵断面上一点Y赋值y1;计算纵断面（pt1-pt2）方位角(setq

9、j1 (atan (/(- y2 y1) (+(- x2 x1) 0.00000001)(setq j2 (/(* j1 180) pi)(if (- y2 y1) 0)(setq sgn 1);符号判断(if (=(- y2 y1) 0)(setq sgn 0)(if (- y2 y1) 0)(setq sgn -1)(setq fwj (+ (- 180(* 90 sgn) j2);方位角计算(setq ang (/(* fwj pi) 180)(setq en (entsel 选择高程点:);要求碰选一个高程点(while en(setq en_data (entget (car en)

10、 ;取得元体资料列表(setq pt (cdr (assoc 10 en_data) ;求得高程点坐标pt(setq py (nth 1 pt);提取测量坐标系Y值(setq px (nth 0 pt);提取测量坐标洗X值(setq px2 (sin ang)(setq px3 (cos ang)(setq cj (-(* (- py y1) (cos ang) (* (- px x1) (sin ang);计算垂直距离（cj）(setq dist (rtos cj 2 0)(setq pz(rtos (nth 2 pt);提取测量坐标系Z值(setq pdz (strcat dist,pz)

11、;输出为CASS数据格式(write-line pdz ff);写入文本(setq en (entsel n选择下一个高程点:)(close file)(prin1)(prompt *从CASS中提取高程点或（point）点坐标,* *输出横断面数据（平距,高程）*)(prin1)批量提取CAD中点（point）三维坐标2010-05-22 23:11:43|分类： 默认分类 |标签： |字号大中小订阅 ;该程序主要用于CAD点（point）三维坐标提取,并将数据输出为CASS软件中使用的数据格式;输出格式： 点号,测量Y值,测量X值,测量Z值 例：1,100.3244,1232,433,25

12、;2010-05-17 罗泽钢 中国葛洲坝集团基础工程有限公司;命令：plzbsc(defun c:plzbsc() (princ n选择所需输出的点（point）:) (setq ss (ssget );选取坐标点 (setq n (sslength ss );计算坐标点数量 (setq ff (open (getfiled 文件保存为 f:/ dat 1) w);保存路径 (setq i 0) (repeat n(setq spt (ssname ss i ) (setq ept (entget spt) (if (= (cdr (assoc 0 ept) POINT) (progn (s

13、etq lxyz (cdr (assoc 10 ept) (setq sx (rtos (nth 1 lxyz);将坐标值实数转换成字符 (setq sy (rtos (nth 0 lxyz) (setq sz (rtos (nth 2 lxyz) (setq i1 (+ i 1);计算点序号 (setq sn (rtos i1 2 0);将序号实数转换成字符 (setq sxyz (strcat sn, sy , sx , sz) (write-line sxyz ff) ) (setq i (+ i 1) );repeat)(prompt *只适合point点 *输出格式（点号, Y,X,

14、Z）*)(prin1)从CASS提取高程点坐标输出到文本2010-05-22 23:15:18|分类： 工程 |标签：高程点提取cass |字号大中小订阅 :2010-05-17 (defun c:gcdtq()(setvar cmdecho 0) ;指令执行过程不响应(setq en (entsel 选择高程点:) ;要求碰选一个高程点(setq ff (open (getfiled 文件保存为 f:/ txt 1) a)(setq en_data (entget (car en) ;取得元体资料列表(setq pt (cdr (assoc 10 en_data) ;求得高程点坐标pt(se

15、tq py(rtos (nth 1 pt);提取测量坐标Y值(setq px(rtos (nth 0 pt);提取测量坐标X值(setq pz(rtos (nth 2 pt);提取测量坐标Z值(setq sxyz (strcat px py pz)(write-line sxyz ff)(prin1)(prompt * *)(prin1);修改后可以实现连续提取2011-02-25(defun c:gcdtq()(setvar cmdecho 0) ;指令执行过程不响应(setq ff (open (getfiled 文件保存为 f:/ dat 1) a)(setq n 0)(while;循环

16、语句(setq en (entsel n 选择高程点:) ;要求碰选一个高程点(redraw (car en) 3);亮显高程点(setq n(+ n 1)(setq pn(rtos n 2 0)(setq en_data (entget (car en) ;取得元体资料列表(setq pt (cdr (assoc 10 en_data) ;求得高程点坐标pt(setq py(rtos (nth 1 pt);提取测量坐标Y值(setq px(rtos (nth 0 pt);提取测量坐标X值(setq pz(rtos (nth 2 pt);提取测量坐标Z值(setq sxyz (strcat p

17、n,px , py , pz)(write-line sxyz ff)(prin1)(princ sxyz)(prompt * *提取高程点输出为CASS格式*)(prin1);VLISP与EXCEL之间连接及数据传输和函数集2011-05-29 08:35:14|分类： 工程 |标签： |字号大中小订阅 ;*; ; DSX-API-Excel.LSP ; ; Visual LISP ActiveX API for Excel 97, 2000 and XP ; ; Copyright (C)2002 David M. Stein, All rights reserved ; ;*; ; Ve

18、rsion 2002.22 05/15/02: Initial release ; ;*; ; Code provided AS-IS without warranty of any kind given for any purpose ; ; or use, either explicitly, implicitly or as a derivative work item. ; ; User assumes ANY AND ALL RISK and LIABILITY for use of any of this code ; ; for any consequential damages

19、 of any kind. These functions are defined ; ; within DSX Tools 2002.22 when loaded into AutoCAD. This document is ; ; provided for informational purposes only. ; ;*; (vl-load-com) ;* ; MODULE: DSX-TypeLib-Excel ; DEs criptION: Returns typelib (olb) file for either Excel 97, 2000, or XP ; ARGS: none

20、; EXAMPLE: (DSX-TypeLib-Excel) ;* (defun DSX-TypeLib-Excel ( / sysdrv tlb) (setq sysdrv (getenv systemdrive) (cond ( (setq tlb (findfile (strcat sysdrv Program FilesMicrosoft OfficeOfficeExcel8.olb) tlb ) ( (setq tlb (findfile (strcat sysdrv Program FilesMicrosoft OfficeOfficeExcel9.olb) tlb ) ( (se

21、tq tlb (findfile (strcat sysdrv Program FilesMicrosoft OfficeOfficeExcel10.olb) tlb ) ( (setq tlb (findfile (strcat sysdrv Program FilesMicrosoft OfficeOfficeExcel.exe) tlb ) ( (setq tlb (findfile (strcat sysdrv Program FilesMicrosoft OfficeOffice10Excel.exe) tlb ) ) ) ;* ; MODULE: DSX-Load-TypeLib-

22、Excel ; DEs criptION: Loads typelib for Excel 97, 2000 or XP (whichever is found) ; ARGS: none ; EXAMPLE: (DSX-Load-TypeLib-Excel) ;* (defun DSX-Load-TypeLib-Excel ( / tlbfile tlbver out) (dsx-princ n(DSX-Load-TypeLib-Excel) (cond ( (null msxl-xl24HourClock) (if (setq tlbfile (DSX-TypeLib-Excel) (pr

23、ogn (setq tlbver (substr (vl-filename-base tlbfile) 6) (cond ( (= tlbver 9) (princ nInitializing Microsoft Excel 2000.) ) ( (= tlbver 8) (princ nInitializing Microsoft Excel 97.) ) ( (= (vl-filename-base tlbfile) Excel.exe) (princ nInitializing Microsoft Excel XP.) ) ) (vlax-import-type-library :tlb

24、-filename tlbfile :methods-prefix msxl- :properties-prefix msxl- :constants-prefix msxl- ) (if msxl-xl24HourClock (setq out T) ) ) ) ( T (setq out T) ) ) out ) ;* ; MODULE: DSX-Open-Excel-New ; DEs criptION: Opens a new session of Excel 97, 2000 or XP ; ARGS: display-mode (SHOW or HIDE) ; EXAMPLE: (

25、setq xlapp (DSX-Open-Excel-New SHOW) ;* (defun DSX-Open-Excel-New (dmode / appsession) (dsx-princ n(DSX-Open-Excel-New) (princ nCreating new Excel Spreadsheet file.) (cond ( (setq appsession (vlax-create-object Excel.Application) (vlax-invoke-method (vlax-get-property appsession WorkBooks) Add ) (if

26、 (= (strcase dmode) SHOW) (vla-put-visible appsession 1) (vla-put-visible appsession 0) ) ) ) appsession ) ;* ; MODULE: DSX-Open-Excel-Exist ; DEs criptION: Gets handle to existing (running) session of Excel 97, 2000, XP ; ARGS: xls-filename, display-mode (SHOW or HIDE) ; EXAMPLE: (setq xlapp (DSX-O

27、pen-Excel-Exist myfile.xls SHOW) ;* (defun DSX-Open-Excel-Exist (xfile dmode / appsession) (dsx-princ n(DSX-Open-Excel-Exist) (princ nOpening Excel Spreadsheet file.) (cond ( (setq fn (findfile xfile) (cond ( (setq appsession (vlax-get-or-create-object Excel.Application) (vlax-invoke-method (vlax-ge

28、t-property appsession WorkBooks) Open fn ) (if (= (strcase dmode) SHOW) (vla-put-visible appsession 1) (vla-put-visible appsession 0) ) ) ) ) ( T (alert (strcat nCannot locate source file: xfile) ) ) appsession ) ;* ; MODULE: DSX-Excel-Put-ColumnList ; DEs criptION: Write each list member to a colum

29、n (startcol) starting at row (startrow) ; ARGS: list, startrow, startcol ; EXAMPLE: (DSX-Excel-Put-ColumnList (A B C) 1 2) puts members into cells (1,B) (2,B) (3,B) respectively ;* (defun DSX-Excel-Put-ColumnList (lst startrow startcol) (dsx-princ n(DSX-Excel-Put-ColumnList) (foreach itm lst (msxl-p

30、ut-value (DSX-Excel-Get-Cell range startrow startcol) itm ) (setq startrow (1+ startrow) ); repeat ) ;* ; MODULE: DSX-Excel-Put-RowList ; DEs criptION: Write each list member to row (startrow) starting at column (startcol) ; ARGS: list, startrow, startcol ; EXAMPLE: (DSX-Excel-Put-RowList (A B C) 2

31、1) puts members into cells (1,B) (1,C) (1,D) respectively ;* (defun DSX-Excel-Put-RowList (lst startrow startcol) (dsx-princ n(DSX-Excel-Put-RowList) (foreach itm lst (msxl-put-value (DSX-Excel-Get-Cell range startrow startcol) itm ) (setq startcol (1+ startcol) ); repeat ) ;* ; MODULE: DSX-Excel-Pu

32、t-CellColor ; DEs criptION: Applies fill-color to specified cell ; ARGS: row, column, color (integer) ; EXAMPLE: (DSX-Excel-Put-CellColor 1 1 14) apply color #14 to cell (1,A) ;* (defun DSX-Excel-Put-CellColor (row col intcol / rng) (setq rng (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp) row col)

33、 (msxl-put-colorindex (msxl-get-interior rng) intcol) ) ;* ; MODULE: DSX-Excel-Put-RowCellsColor ; DEs criptION: Applies fill-color to a row of cells ; ARGS: startrow, startcol, num-cols, color (integer) ; EXAMPLE: (DSX-Excel-Put-RowCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 columns usin

34、g color #14 ;* (defun DSX-Excel-Put-RowCellsColor (startrow startcol cols intcol / next) (dsx-princ n(DSX-Excel-Put-RowCellsColor) (setq next startcol) (repeat cols (DSX-Excel-Put-CellColor startrow next intcol) (setq next (1+ next) ) ) ;* ; MODULE: DSX-Excel-Put-ColumnCellsColor ; DEs criptION: Cha

35、nge fill color in a column of cells ; ARGS: startrow, startcol, num-rows, color (integer) ; EXAMPLE: (DSX-Excel-Put-ColumnCellsColor 1 1 5 14) Start at row=1 col=1 repeat for 5 rows using color #14 ;* (defun DSX-Excel-Put-ColumnCellsColor (startrow startcol rows intcol / next) (dsx-princ n(DSX-Excel

36、-Put-ColumnCellsColor) (setq next startrow) (repeat rows (DSX-Excel-Put-CellColor next startcol intcol) (setq next (1+ next) ) ) ;* ; MODULE: DSX-Excel-Get-Cell ; DEs criptION: Get cell object relative to range using (relrow) and (relcol) offsets ; ARGS: range-object, relative-row, relative-col ; EX

37、AMPLE: (DSX-Excel-Get-Cell rng1 2 2) ;* (defun DSX-Excel-Get-Cell (rng relrow relcol) (dsx-princ n(DSX-Excel-Get-Cell) (vlax-variant-value (msxl-get-item (msxl-get-cells rng) (vlax-make-variant relrow) (vlax-make-variant relcol) ) ) ) ;* ; MODULE: DSX-Excel-Get-CellValue ; DEs criptION: Return value

38、 in given cell (row, column) of active session object (xlapp) ; ARGS: row(int), column(int) ; EXAMPLE: (DSX-Excel-Get-CellValue 1 2) ;* (defun DSX-Excel-Get-CellValue (row col) (dsx-princ n(DSX-Excel-Get-CellValue) (vlax-variant-value (msxl-get-value (DSX-Excel-Get-Cell (msxl-get-ActiveSheet xlapp)

39、row col ) ) ) ) ;* ; MODULE: DSX-Excel-Get-RowValues ; DEs criptION: Returns a list of cell values within a given row ; ARGS: row-number(int), startcol, num-cells ; EXAMPLE: (DSX-Excel-Get-RowValues 3 1 20) get first 20 values in row 3 ;* (defun DSX-Excel-Get-RowValues (row startcol numcells / next

40、out) (dsx-princ n(DSX-Excel-Get-RowValues) (setq next startcol) (repeat numcells (setq out (if out (append out (list (DSX-Excel-Get-CellValue row next); row x col (list (DSX-Excel-Get-CellValue row next); row x col ) next (1+ next) ) ); repeat out ) ;* ; MODULE: DSX-Excel-Get-ColumnValues ; DEs crip

41、tION: Returns a list of cell values within a given column ; ARGS: column-number(int), startrow, num-cells ; EXAMPLE: (DSX-Excel-Get-ColumnValues 2 1 20) get top-20 entries in column 2 (B) ;* (defun DSX-Excel-Get-ColumnValues (col startrow numcells / next out) (dsx-princ n(DSX-Excel-Get-ColumnValues)

42、 (setq next startrow) (repeat numcells (setq out (if out (append out (list (DSX-Excel-Get-CellValue next col) (list (DSX-Excel-Get-CellValue next col) ) next (1+ next) ) ); repeat out ) ;* ; MODULE: DSX-Excel-GetRangeValues-ByRows ; DEs criptION: Get range values in row order and return as nested li

43、sts ; ARGS: startrow, startcol, num-rows, num-cols ; EXAMPLE: (DSX-Excel-GetRangeValues-ByRows 1 1 5 10) get range values from 1A to 5J where each sublist is one row ;* (defun DSX-Excel-GetRangeValues-ByRows (startrow startcol numrows numcols / nextrow rowlst outlst) (dsx-princ n(DSX-Excel-GetRangeV

44、alues-ByRows) (setq nextrow startrow) (repeat numrows (setq rowlst (DSX-Excel-Get-RowValues nextrow startcol numcols) outlst (if outlst (append outlst (list rowlst) (list rowlst) nextrow (1+ nextrow) ) ) outlst ) ;* ; MODULE: DSX-Excel-GetRangeValues-ByCols ; DEs criptION: Get range values in column

45、 order and return as nested lists ; ARGS: startrow, startcol, num-rows, num-cols ; EXAMPLE: (DSX-Excel-GetRangeValues-ByCols 1 1 5 10) get range values from 1A to 5J where each sublist is one column ;* (defun DSX-Excel-GetRangeValues-ByCols (startrow startcol numrows numcols / nextrow nextcol collst

46、 outlst) (dsx-princ n(DSX-Excel-GetRangeValues-ByCols) (setq nextcol startcol) (repeat numcols (setq collst (DSX-Excel-Get-ColumnValues nextcol startrow numrows) outlst (if outlst (append outlst (list collst) (list collst) nextcol (1+ nextcol) ) ) outlst ) ;* ; MODULE: DSX-Excel-Get-ActiveWorkSheet

47、; DEs criptION: Returns object of active worksheet in active Excel session ; ARGS: app (session object) ; EXAMPLE: (DSX-Excel-Get-ActiveWorkSheet xlapp) ;* (defun DSX-Excel-Get-ActiveWorkSheet (xlapp) (dsx-princ n(DSX-Excel-Get-ActiveWorkSheet) (msxl-get-ActiveSheet xlapp) ) ;* ; MODULE: DSX-Excel-RangeAutoFit ; DEs criptION: Applies Auto-Fit to columns within active range ; A