dxpmx1.lsp

在CAD电子地图中根据路径多段线剖 纵断面图。

(defun c:pmx (/	  olderr     fn	index	 data	  dclfg	   filename
	      b	       ce	osmode	 style_list	   styleflg
	      sl
	     )
  (vl-load-com);;启动Vlisp支持，CAD2000以上
  
  (defun m_myerror(msg);;自定义错误处理函数
     (command"undo" "e") ;;结束(E)
     (command"undo" "")  ;放弃操作
     (if ce (setvar "cmdecho" ce))
     (if osmode (setvar "osmode" osmode))
     (setq *error* olderr);;恢复系统错误处理过程
     (princ"\n\n程序非正常退出! 出错信息：")(princ msg)
  )
  
  (setq olderr *error*)
  (setq *error* m_myerror);;替换系统错误处理函数

  (setq ce (getvar "cmdecho"))  ;;命令行响应
  (setvar "cmdecho" 0)          ;;关闭
  (setq osmode (getvar "osmode"));;对象捕捉
  (setvar "osmode" 16385)

  (command"undo" "be") ;;开始(BE)
  
  (setq	dclfn "pmx"    ;;定义dcl对话框函数名
	fg    1        ;;fg=1
	b     nil      ;;b=null
  )
  (if (> (setq index (load_dialog dclfn)) 0);;加载dcl成功，index 〉0
    (progn                                  ;;evaluate several expressions where only one expression is expected.
      (if (new_dialog "Init_Pmx" index)     ;;(new_dialog dlgname dcl_id [action [screen-pt]]) 
	(progn
	  (mode_tile "m_myinfo" 1)          ;;(mode_tile key mode)0  Enable tile
	                                    ;;;1  Disable tile
	                                    ;;;2  Set focus to tile
	                                    ;;;3  Select edit box contents
	                                    ;;;4  Flip image highlighting on or off 

	;读出当前图中的所有字体
	  (setq	style_list
		 (cons (cdadr (tblnext "style" T))  ;;Adds an element to the beginning of a list, or constructs a dotted list
                                                    ;;(tblnext table-name [rewind]) ,rewind=true, the first entry in it is retrieved. 
		       '()
		 )
	  )
	  
	  (while (setq styleflg (tblnext "style"))
	    (setq style_list
		   (cons (cdadr styleflg)
			 style_list
		   )
	    )
	  )
	  
	  (if (member "" style_list)
	    ;;清除为空的字体
	    (progn
	      (setq styleflag '())
	      (mapcar '(lambda (x)                 ;;The lambda function can specify an anonymous function to be performed by mapcar
			 (if (/= "" x)             
			   (setq
			     styleflag (cons x
					     styleflag
				       )
			   )
			 )
		       )
		      style_list
	      )                                  ;;mapcar对自定义函数批处理后，styleflag临时表中的字体表与实际相反
	      (setq style_list (reverse styleflag))
	    )
	  )
	  (start_list "zt")                     ;;操作表
	  (setq sl style_list)
	  (repeat (length style_list)           ;;the number of elements in a list 
	    (if	(/= "" (car sl))                ;;car-Returns the first element of a list。字型名为空时
	      (add_list (car sl))
	    )
	    (setq sl (cdr sl))
	  )
	  (end_list)                           ;;end表操作

	  (mode_tile "pg_inf" 1)               ;;mode 0  Enable tile 
                                               ;;1  Disable tile 
                                               ;;2  Set focus to tile 
                                               ;;3  Select edit box contents 
                                               ;;4  Flip image highlighting on or off 

	  (action_tile "saved" "(mod)")       ;;选择“已保存的”，执行mod
	  (action_tile "new" "(mod)")         ;;选择“新数据”，执行mod
	  (action_tile "gc_zd" "(mod)")       ;;自动获取
	  (action_tile "gc_sg" "(mod)")       ;;手工输入
	  (mode_tile "new" 2)                 ;;2  Set focus to tile 
	  (mode_tile "sjwj" 1)                ;;数据文件disable         
	  (mode_tile "ytbl" 2)                ;;原图比例
	  (mode_tile "gc_zd" 2)               
	  (mode_tile "htbl" 2)                ;;绘图比例               
	  (action_tile
	    "ytbl"
	    "(if(= 2 $reason)(set_tile\"error\"\"\"))";;隐藏错误提示
	  )
	  (action_tile
	    "hzbl"
	    "(if(= 2 $reason)(set_tile\"error\"\"\"))"
	  )
	  (action_tile
	    "zt"                       ;;字体
	    "(if(= 2 $reason)(set_tile\"error\"\"\"))"
	  )
	  (action_tile
	    "bh"                       ;;剖面编号
	    "(if(= 2 $reason)(set_tile\"error\"\"\"))"
	  )
	  (action_tile
	    "gc_dgj"                  ;;等高距
	    "(if(= 2 $reason)(set_tile\"error\"\"\"))"
	  )
	  (action_tile "bcsj" "(mode_tile \"fn\" 2)")    ;;“保存数据”变动，文件名（fn）显示焦点
	  (action_tile "yn"                              ;;“是否保存数据”，yn=1，数据文件标签Enable tile，fn获得焦点，否则焦点转移到ytbl
	    "(set_tile \"error\" \"\")                   
             (if (= \"1\" (get_tile\"yn\"))
               (progn
                 (mode_tile \"sjwj\" 0)
                 (mode_tile \"fn\" 2)
               )
               (progn
                 (mode_tile \"sjwj\" 1)
                 (mode_tile\"ytbl\"2)
               )
             )"
	  )
	  (action_tile "wjm" "(setq b (get_file))")     ;;从文件浏览器获得文件名，b为指针
	  (action_tile
	    "ok"        ;;按下文件浏览器ok，style_list赋值给data，如采用已保存数据，打开文件成功fg=0，并检查
	                ;;data是否为表，fg=0，如果数据data不是fn，data获得焦点
	    "(if (setq data (Init_data style_list))
	         (if (= \"1\" (get_tile \"saved\"))
	            (if b
	               (progn
	                  (setq fg 0)
	                  (done_dialog 0)
	               )
	            )
	            (if (listp data)
	              (progn
	                (setq fg 0)
	                (done_dialog 0)
	              )
	              (if (/= \"fn\" data)
	                (mode_tile data 2)
	              )
	            )
	         )
	    )"
	  )
	  (action_tile "cancel" "(done_dialog 0)") ;;定义退出
	  (start_dialog)                           ;;Displays a dialog box and begins accepting user input 
	)
	(alert "不能显示对话框!")
      )
      (unload_dialog index)
    )
    (alert "未找到对话框文件!")                    ;;加载dcl不成功，
  )
  (if (= 0 fg)
    (if	b
      (draw_pmx b data)
      (pmxs data)
    )
  )
  (setvar "cmdecho" ce)
  (setvar "osmode" osmode)
  (setq *error* olderr)       ;;恢复系统错误处理过程
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_file(/ b fn)
  ;;打开或保存数据文件
  (if (= "1" (get_tile "new"));;如果当前是新数据
    (progn
      (setq fn (getfiled "保存文件..." "" "" 1))
      (if fn (set_tile "fn" fn));;显示文件名
      (set_tile "error" "");;清除错误提示
      (setq b nil)
    )
    (progn
      (setq fn (getfiled "打开文件..." "" "" 0))
      (if fn
	(progn
	  (setq b (readdata_fromfile fn));;读入剖面数据文件
	  (if b
	    (progn
	      (set_tile "fn" fn)
	      (set_tile "error" "");;清除错误提示
	    )
	  )
	)
      )
    )
  )
  b
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;readdata_fromfile;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun readdata_fromfile (filename / fn init_data n b l1)
  (if (setq fn (open filename "r"))                      ;;readonlymode
    (progn
      (if (setq l1 (read-line fn))                      ;;Reads a string from the keyboard or from an open file, until an end-of-line marker is encountered 
	(if (listp (setq init_data (read l1)))          ;;read:Returns the first list or atom obtained from a string 
	  (progn
	    (setq
	      init_data
	       (reverse	(cons filename
			      (reverse init_data)
			)
	       )
	    )
	    ;;原图比例，绘制比例，字体，剖面编号，等高距，文件名，是否输出数据
	    ;;高程调整量，高程自动获得开关
	    (setq b '("ytbl" "hzbl" "zt" "bh" "gc_dgj" "fn" "yn"
		      "gc_tzz" "gc_zd")
		  n 0
	    )

	    (repeat 6
	      (set_tile (nth n b) (nth n init_data))    ;;(zero is the first element). 
	      (setq n (1+ n))
	    )
	    (setq n (1+ n))
	    (set_tile (nth n b) (nth n init_data))      ;;高程调整量
	    (set_tile "zt" (getvar "textstyle"))        ;;使用当前textstyle
                    ;;保存数据，字体，剖面编号，比例尺，字体,b为临时表
	    (setq b '("bcsj" "zhiti" "pmbh" "blc" "ziti")
		  n 0
	    )
	    (mapcar '(lambda (x) (mode_tile x 0)) b) ;;显示标题,Enable tile 
	    (setq b '("ytbl" "bcsj"))
	    (mapcar '(lambda (x) (mode_tile x 1)) b) ;;不显示ytbl,bcsj标题
	    (setq b '()
		  init_data nil                      ;;置空init_data
	    )
	    (while (setq init_data (read-line fn))   ;;读第2-n行数据,直到文件结束
	      (setq b (cons (read init_data) b))     ;;the first list实际放在最后
	    )				             ;读入剖面数据段
	    (close fn)
	    (setq b (reverse b))
	  )                                          ;;正常剖面数据读入结束

	  (progn
	    (alert
	      (strcat "此文件不是剖面数据文件!"
		      (strcase filename 1)         ;;1,小写文件名
	      )
	    )
	    (close fn)
	    (setq b nil)                           ;;置空临时表b
	  )
	)
	(progn (set_tile "error"
			 "此文件不是剖面数据文件或格式不正确!"
	       )
	       (close fn)
	       (setq b nil)
	)
      )
    )
    (progn (alert (strcat "不能打开文件!\n\n" (strcase filename 1)))
	   (setq b nil)
    )
  )
  (setq b b)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;mod;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;标题显示模式控制;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mod (/ tb1 tb2 n)
  (set_tile "fn" "")
  (set_tile "error" "")
          ;;保存数据,高程方式,高程自动,等高距,数据文件,字体,剖面编号,比例尺
  (setq	tb1 '("bcsj" "gcfs" "gc_zd_y" "gc_dgj_y" "sjwj"	"ziti" "pmbh" "blc")
	n   0
  )
  (if (= "1" (get_tile "saved"))
    (setq tb2 '(1 1 1 1 0 1 1 1))
    (if	(= "1" (get_tile "gc_zd"))
;;;      (if (= "1" (get_tile "yn"))
;;;	  (setq tb2 '(0 0 0 0 0 0 0 0))
;;;	  (setq tb2 '(0 0 0 0 1 0 0 0))
;;;      )
      (if (= "1" (get_tile "yn"))
;;;	  (setq tb2 '(0 0 1 1 0 0 0 0))
	  (setq tb2 '(0 0 1 1 1 0 0 0))
      )
    )
  )
  (repeat 8
    (mode_tile (nth n tb1) (nth n tb2))
    (setq n (1+ n))
  )
  (if (= "1" (get_tile "saved"))
    (mode_tile "fn" 2)               ;;setfocus
    (if	(= "1" (get_tile "gc_zd"))
      (mode_tile "gc_dgj" 2)
      (mode_tile "ytbl" 2)
    )
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;初始化数据检查是否完整;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Init_data (style_list / data tb lth fn)
  (setq	data '()                        ;;data,tb为临时表
	tb   '("ytbl" "hzbl")
  )
  (setq data (mapcar 'get_tile tb))	;取得比例数据
  (setq tb (get_tile "zt"))             ;zt字体序号
  (setq data (append data (list (nth (atoi tb) style_list))));;连接比例数据表,zt对应style_list表
  ;;剖面编号,等高距,文件名,yesno,高程调整值,高程自动获取标识
  (setq tb '("bh" "gc_dgj" "fn" "yn" "gc_tzz" "gc_zd"))
  (setq tb (mapcar 'get_tile tb)) ;;以上tile对应数据
  (setq data (append data tb))    ;;添加到data
  ;data数据表内容---(原图比例 绘制比例 字型名 剖面编号  等高距 文件名 是否保存数据 高程调整值  是否自动获取高程)
  (setq	tb '("ytbl" "hzbl" "zt"	"bh" "gc_dgj" "fn" "yn"	"gc_tzz" "gc_zd"))
  (setq lth (length (member "" data)))
  (if (> lth 4)
    (progn
      (set_tile "error" "数据未输完!")
      (setq data (nth (- (length tb) lth) tb))  ;;空值及其之后的数据
    )
    (progn
      (if (= "1" (get_tile "new"))               ;;选中新数据
        (if (or (= "1" (nth 6 data)) (= "1" (nth 8 data)));;保存数据标志为1,或自动获取高程志为1
	  (progn
	    (if (= "1" (nth 6 data))	;要保存数据
	      (if (= "" (nth 5 data))	;文件名为空时,错误处理
		(progn
		  (set_tile "error" "请输入保存数据文件名!")
		  (setq data (nth 5 tb))
		)
	      )
	      (if (and (= "" (nth 7 data)) (= "1" (nth 8 data)));高程调整值为空且自动获取高程志为1