jfh1
路人甲
路人甲
  • 注册日期2004-05-07
  • 发帖数38
  • QQ
  • 铜币57枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1569回复:0

[分享]

楼主#
更多 发布于:2004-07-25 10:04
<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" />
喜欢0 评分0
游客

返回顶部