阅读:1728回复:0
[分享]
<P><FONT face=隶书 color=#f73809 size=1> 这是我很多年以前写的一个小程序,可读取屏幕点的二维坐标,主要用来检查地形图的平面绝对精度,现在我早已不再搞LISP了,基本上也不再写代码了!这样的程序还有好多好多,在生产上曾起到过很重要的作用,丢掉了实在可惜,今后将在论坛上相继发表,希望对各位能有所帮助!</FONT></P>
<P><FONT face=隶书 size=1>;-----------------------------------------------------------------</FONT></P> <P>;屏幕坐标写入文件LISP源码(XY-文件)</P> <P>;----------------------------------------------------------------- (defun C:jfhxy() (setvar "cmdecho" 0) ;;;(setvar "osmode" 0) (princ "\n")(setq pf (getstring "请输入坐标数据文件名:")) (setq pf (strcat pf ".dat")) (setq fw (open pf "w")) (princ "\n")(princ "请捕捉第1点屏幕坐标(按回车结束)" ) (setq i 1) (while (/= (setq pt (getpoint)) nil)</P> <P> (command "Text" "j" "Ml" pt 1.2 0 i) (command "point" pt)</P> <P> (setq x (car pt)) (SETQ px (RTOS x 2 3)) (setq y (nth 1 pt)) (SETQ py (RTOS Y 2 3)) (princ "\n")(princ "第")(princ i)(princ "点坐标为:")(princ " X=") (princ py) (princ " Y=")(princ px) (princ " H=") (princ "无")(princ "\n") (princ i fw)(princ "," fw)(princ "," fw) (princ px fw)(princ "," fw)(princ py fw) (princ "," fw) (princ "\n" fw) (setq i (1+ i)) (princ "\n")(princ "请捕捉第")(PRINC i)(PRINC "点屏幕坐标(按回车结束)" ) ) (CLOSE FW) )</P> <P> </P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em08.gif" /> |
|