tmp-源代码.lsp

基于CAD开发的测绘行业应用程序！本程序满足沉降观测的示意图绘制、报表生成等功能

;;-------------将逗号或空格分隔的ll串转为B表---------
(defun c_b (ll / n i0 ii zc b di m)
  (setq m (strlen ll))
  (setq ll (substr ll 11 m))		;预处理字符串，抹掉日期和两个个的  ","

  (setq	i0 0				;指定有效字符的起始位置
	ii 1				;指定有效字符的终点位置
	zc (substr ll 1 1)		;遍历每个字符
	b  '()				;起始表为空
	n  (strlen ll)			;一行数据的长度
  )

  (while (and (> n 0) (> n i0))
    (setq i0 ii)			;
    (while (or (= zc ",") (= zc " ") (= (ascii zc) 9))
					;获取分隔符位置——条件是：zc为分隔字符
      (setq i0 (1+ i0)			;指定到有效字符的起始位置
	    zc (substr ll i0 1)
      )
    )
    (setq ii i0)			;此时io指向分隔符下一位置，即下一有效字符的起始位置
    (while (or (< (ascii zc) 0) (and (> zc " ") (/= zc ",")))
					;获取下一分隔符位置
      (setq ii (1+ ii)			;
	    zc (substr ll ii 1)		;
      )
    )
    (setq di (substr ll i0 (- ii i0)))	;
    (if	(/= di "")
      (setq b (append b (list di)))	;
    )
  )
  b					;返回B表
)

;;;;;;;;;;;;;;;;;;;;;;;;========================================

(defun c:cgb (/)
  (setq oldcmd (getvar "cmdecho")
	oldosm (getvar "osmode")
	)
  (setvar "cmdecho" 0)                  ;关闭命令回显
  (setvar "osmode" 0)			;关闭所有捕捉，防止干扰

  (setq n 0)				;初始化行号---本次观测的个数   n
  (setq mm 0)
					;初始化累计值-本次观测的个数   leiji
  (setq nn 0)				;记数读取的是第几个数据
  (setq nnm 0)				;记数读取的是第几个数据

  (setq tn 0)
  (setq guance 0.0)
  (setq leiji 0.0)
  (setq leiji1 0.0)

  (setq m (getint "\n本次数据为第几次沉降观测成果："))
					;指定观测数据次数   M
  (setq data (getstring "\n本次数据的观测日期为****(年)**(月)**(日) :"))
					;指定观测数据日期
  (setq shigon (getstring "\n本次数据对应的施工阶段："))

  (setq	year (substr data 1 4)
	moth (substr data 5 2)
	dari (substr data 7 2)
  )

  (setq biaol (strcat data ","))	;初值字符串


  (if (= m 1)
    (progn
      (command "insert" "tou2" "0,0" "" "" "") ;插入头文件块2
      (command "insert"
	       "tou1"
	       "0,0"
	       ""
	       ""
	       ""
	       (strcat "施工阶段：" shigon)
	       (strcat "第 " (rtos m 2 0) " 次")
	       (strcat "观测日期：" year "." moth "." dari)
      )					;插入头文件块1,并写入属性信息
    )
  )
  (if (/= m 1)
    (command "insert"
	     "tou1"
	     (strcat (rtos (* (- m 1) 36)) ",0")
	     ""
	     ""
	     ""
	     (strcat "施工阶段：" shigon)
	     (strcat "第 " (rtos m 2 0) " 次")
	     (strcat "观测日期：" year "." moth "." dari)

    )					;插入头文件块2
  )
  (print "\n请选择沉降观测数据文件")
  (print)
  (setq	fl (getfiled "请选择沉降观测数据文件" "" "txt" 8) ;    获取文件路径
  )
   
  (if (= m 1)
    (progn
      (print "\n请指定新建的文本文件以保存系统数据")
      (print)
      (setq tmp (getfiled "请选择新建的数据系统文件" "" "txt" 8);tmp为临时文件的路径
	    )
     )
    )
;;;;;/////////
  (if (/= m 1)
    (progn
      (print "请指定保存系统数据的文本文件")
      (print)
      (setq tmp (getfiled "请选择数据系统文件" "" "txt" 8);tmp为临时文件的路径
		)
      )
    )
  
  (setq fii (open fl "r"))
  (setq lll (read-line fii))		;每一行的数据仅为观测的高程
  (while (/= lll nil)

    (setq tn 0)
    (setq n (+ n 1))			;第N个观测记录

    (if	(= m 1)
      (progn
	(setq biaol (strcat biaol "," lll "," (rtos 0)))
	(command "insert"
		 "sor2"
		 (strcat "0," (rtos (* n -4) 2 0))
		 ""
		 ""
		 ""
		 (strcat "1-" (rtos n 2 0))
	)
	(command "insert"
		 "sor"
		 (strcat "0," (rtos (* n -4) 2 0))
		 ""
		 ""
		 ""
		 lll
		 " "
		 " ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	)
      )					;end progn
    )					;end if (m=1)

    (if	(/= m 1)
      (progn

	(setq tmpo (open tmp "r"))	;打开临时文件
	(setq tmpol (read-line tmpo))	;读取一行临时文件数据
	(setq tn (+ tn 1))		;记录临时文件的行数

	(if (/= tn (- m 1))

	  (while (and (/= tn (- m 1)) (/= tmpol nil));;读取临时记录文件
	    (setq tn (+ tn 1))		;记录临时文件的行数
	    (setq tmpol (read-line tmpo)) ;读取一行临时文件数据
	  )
	)
	(setq s1 (c_b tmpol))		;转化为表
	(close tmpo)
	(setq guance (nth (* 2 (- n 1)) s1))
					;返回临时文件中对应行的相应   观测记录值
	(setq leiji (nth (- (* 2 n) 1) s1))
					;返回临时文件中对应行的相应        累计值

	(setq cha (rtos (* (- (atof lll) (atof guance)) 1000) 2 1))
	;;转换为MM，且保留一位小数

	(setq leiji (+ (atof leiji) (atof cha)))

	(setq biaol (strcat biaol "," lll "," (rtos leiji 2 1)))
					;记录并扩展字符串，以备写入临时文件

	(command "insert"
		 "sor"
		 (strcat (rtos (* (- m 1) 36)) "," (rtos (* n -4)))
		 ""
		 ""
		 ""
		 lll
		 cha
		 (rtos leiji 2 1)
	)				;插入块，并赋属性值

      )					;end progn
    )					;end if (/= m 1)

    (setq lll (read-line fii))		;每一行的数据仅为观测的高程

  )					;end while   (/= lll nil)

  (close fii)
  (setq tmpx (open tmp "a"))		;写入临时文件数据
  (write-line biaol tmpx)
  (close tmpx)

  (command "zoom" "e")
  (setvar "cmdecho" oldcmd)
  (setvar "osmode" oldosm)
  (princ "\n完成!")
  (princ)
)					;end defun


;;;;;'''''''''''''''''''''''''''''''    成果示意图

(defun c:syt (/)
  (setq oldcmd (getvar "cmdecho")
	oldosm (getvar "osmode")
	)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (setq	dx 0
	dy 0
	i 0
  )

  (print "\n请指定保存系统数据的文本文件")
  (print)
  (setq file (getfiled "请选择数据系统文件" "" "txt" 8))

  (if (= file nil)
    (*error* "不可操作的文件！")
    )
  (setq opfi (open file "r"))
  (setq fil1 (read-line opfi))		;读取一个记录
  (while (/= fil1 nil)
    (setq i (+ i 1))
    (setq fil1 (read-line opfi))
    )
  (princ "\n请指定你期望绘制示意图")
;;;  (setq id (getint "请指定你期望绘制示意图所包含的观测次数(>=2)："))
  (setq id (getint (strcat "所包含的观测次数N (2<= N <=" (rtos i 2 0) "): ")))
  
  (while (> id i)
    (setq id (getint "\n指定的观测次数大于实际值，请重新输入："))
    )
  (setq n 0)
  (setq bb '())
  ;; 记录计算的坐标值----格式为x1 y1 x2 y2……
  (setq by '())
  ;; 记录时间
  (setq opfi (open file "r"))
  (setq fil1 (read-line opfi))		;读取一个记录
  (setq datacs (substr fil1 1 8))	;提取记录的时间
  (setq	yearcs (substr datacs 1 4)
	mothcs (substr datacs 5 2)
	darics (substr datacs 7 2)
  )
  (while (and (/= fil1 nil) (< n id))
    (setq n (+ n 1))
    (setq data (substr fil1 1 8))	;提取记录的时间
    (setq year (substr data 1 4)
	  moth (substr data 5 2)
	  dari (substr data 7 2)
    )
    (if	(= n 1)
      (setq by (append by (list (strcat "   " year "." moth "." dari))))
    )
    (if	(/= n 1)
      (setq by (append by (list (strcat "— " year "." moth "." dari))))
    )
    (setq xtime
	   (* (+
		(* (- (atoi year) (atoi yearcs)) 360.0)
		 (* (- (atoi moth) (atoi mothcs)) 30.0)
		(- (atoi dari) (atoi darics))
	      )
	      0.5;;;;;;;;;;;;;;;;;;;;;;;
	   )
    )
    (setq bb (append bb (list xtime)))
;;;;
    ;;计算X轴步长----（y2-y1)*360 +(m2-m1)*30+(d2-d1)


    (setq ss1 (c_b fil1))		;chuli
    (setq index 0)
    (setq leiji 0.0)
    (setq leijip 0.0)
    (setq leijit 0.0)
    (setq yleiji 0.0)
    
    (setq len (/ (length ss1) 2))
    
    (repeat len
      
      (setq index (+ index 1))
      (setq leiji (atof (nth (- (* index 2) 1) ss1)))
					;返回临时文件中对应行的相应        累计值
      (setq leijit (+ leijit leiji))
    )
    
    (setq leijip (/ leijit len))	;取平均
    
    (setq yleiji (* leijip 10.0))
    (setq bb (append bb (list yleiji)))
    
    (setq fil1 (read-line opfi))	;读取一个记录
  )					;end while
  (close opfi)

;;;画曲线
  (setq nm 1)
  (command "line")
  (repeat id
    (setq xx (nth (* (- nm 1) 2) bb))	;提取X坐标
    (setq yy (nth (- (* nm 2) 1) bb))	;提取Y坐标
    (setq nm (+ nm 1))
    (command (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy))))
  )
;;;画曲线
  (command "")
  ;;;添加圆圈标识
  (setq nm 1)
  (repeat id
    (setq xx (nth (* (- nm 1) 2) bb))	;提取X坐标
    (setq yy (nth (- (* nm 2) 1) bb))	;提取Y坐标
    (setq nm (+ nm 1))
    (command "circle" (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy))) (/ (* 0.6 id) 9.0));0.6*id/9
  )
  ;;;添加圆圈标识
;;;画x线
  (setq nm 1)
  (command "line")
  (repeat id
    (setq xx (nth (* (- nm 1) 2) bb))	;提取X坐标
    (setq yy 0)				;提取Y坐标

    (setq tim (nth (- nm 1) by))

    (setq nm (+ nm 1))

    (command (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy))) "")

    (if (= nm 2);第一次写入日期标志，对齐方式更改
    (command "text"
	     "j"
	     "tl"
	     (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy)))
	     (/ (* 2.0 id) 9.0)
	     "90"
	     tim
    )
      (command "text"
	     "j"
	     "ml"
	     (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy)))
	     (/ (* 2.0 id) 9.0)
	     "90"
	     tim
    )

      );end if
    
    (command "line" (strcat (rtos (+ xx dx)) "," (rtos (+ yy dy)))
    )
  )
;;;;;;画x线

  (command (strcat (rtos (+ xx 10)) "," (rtos (+ yy dy))))
  (command "")
  
  (command "text" "j" "m" (strcat (rtos (+ xx 10)) "," (rtos (+ yy 2.5))) (/ (* 2.5 id) 9.0) "0"  "沉降  曲线")
  (command "text" "j" "m" (strcat (rtos (+ xx 10)) "," (rtos (- yy 2.5))) (/ (* 2.5 id) 9.0) "0"  "日期   (天)")
  
;;;画y线

  (setq blb (reverse bb))
  (setq leijimax (- (car blb) 10.0))	;最大累计值

  (command "line"
	   "0,20"
	   (strcat (rtos dx) "," (rtos (+ (fix (+ leijimax dy)) 2)))
	   ""
  );;画竖线
  (command "text" "j" "ml" (strcat (rtos (+ dx 2)) "," (rtos (+ (fix (+ leijimax dy)) 5))) (/ (* 2.5 id) 9.0) "90" "沉降量  (毫米)");写标注
  (setq ddy 0)
  (while (> ddy leijimax)
    (command "insert"
	     "cha"
	     (strcat (rtos 0) "," (rtos ddy))
	     ""
	     ""
	     ""
	     " "
    )
    (command "text" "j" "mr" (strcat (rtos -2) "," (rtos ddy)) (/ (* 4.0 id) 9.0) "0" (rtos (/ ddy 10.0) 2 0))
    (setq ddy (- ddy 25))
    (command "insert"
	     "du"
	     (strcat (rtos dx) "," (rtos ddy))
	     ""
	     ""
	     ""
    )
    (setq ddy (- ddy 25))
  )					;end (while (< ddy leijimax)
  
  (command "zoom" "e")
  (setvar "cmdecho" oldcmd)
  (setvar "osmode" oldosm)
  (princ "\n完成!")
  (princ)
);end defun

;;;;--------------------自定义错误处理函数
(defun *error* (msg)
    (princ "程序出错或用户取消!")
    (princ msg)
    (terpri) 
    )