;;;------------------------------
;;;1999.03.15 yft
;;;路面结构型式图
;;;------------------------------
;; 全局变量 : patb patb1 ??img_sty ??tasz_list ??sj_list ??ta_style
;;;??sj_list (名称 厚度 (图案名 图案角度 图案比例))

(defun ?dl_lmjg	(/	      dcl_id	   what		?dl_lmjg_sub1
		 ??img_sty    ??tasz_list  ??sj_list	patb
		 szlist	      ?dl_lmjg_sub3		?dl_lmjg_sub4
		 ?sub_add     ?sub_del	   ?sub_down	?sub_up
		 ?chksj	      ?drawing	   pt1		patbuser
		 patbacad     ??ta_style   initname
		)

;;; button选图案:选填充图案并显示,名称赋给??img_sty
  (defun ?dl_lmjg_sub1 (/      maxll  page0  page1  page   jj
			ii     what1  pat    prev   next   dopat
			x      y
		       )
    ;; 选中pat
    (defun dopat (pag / patnum pat1)
      (setq patnum (substr $key 4))
      (setq patnum (+ (atoi patnum) (* 12 pag)))
      (if (> patnum 52)
	(princ)
	(progn
	  (done_dialog 1)
	  (setq pat1 (nth patnum patb))
	)
      )
      pat1
    )

    ;; 前页
    (defun prev	(jj / mm ii)
      (setq jj (- jj 1))
      (mode_tile "next" 0)
      (if (= jj 0)
	(mode_tile "prev" 1)
      )
      (setq mm (* 12 jj))
      (setq ii 0)
      (repeat 12
	(if (= ??ta_style 0)
	  (playsld (strcat "dpat(" (nth (+ mm ii) patb) ")")
		   (strcat "img" (itoa (+ mm ii)))
	  )
	  (progn
	    (play_path_sld (strcat "acad(" (nth (+ mm ii) patb) ")") (strcat "img" (itoa ii)))
	  )
	)
	(setq ii (1+ ii))
      )
      jj
    )

    ;; 次页
    (defun next	(jj / mm ii)
      (setq jj (+ jj 1))
      (mode_tile "prev" 0)
      (if (= jj (- page 1))
	(mode_tile "next" 1)
      )
      (setq mm (* 12 jj))
      (setq ii 0)
      (repeat 12
	(if (= ??ta_style 0)
	  (playsld (strcat "dpat(" (nth (+ mm ii) patb) ")")
		   (strcat "img" (itoa (+ mm ii)))
	  )
	  (progn
	    (play_path_sld (strcat "acad(" (nth (+ mm ii) patb) ")") (strcat "img" (itoa ii)))
	  )
	)
	(setq ii (1+ ii))
      )
      jj
    )

    (if	(not (new_dialog "spat1" dcl_id))
      (exit)
    )
    (setq maxll	(length patb)
	  page0	(/ maxll 12.0)
	  page1	(fix page0)
    )
    (if	(> (- page0 page1) 0)
      (setq page (+ page0 1))
      (setq page page0)
    )

    (setq x (dimx_tile "img0"))
    (setq y (dimy_tile "img0"))
    (setq x (+ 20 x)
	  y (+ 5 y)
    )

    (setq jj 0)
    (mode_tile "prev" 1)
    (if	(> page 1)
      (mode_tile "next" 0)
      (mode_tile "next" 1)
    )
    (setq ii 0)
    (repeat 12
      (if (= ??ta_style 0)
	(playsld (strcat "dpat(" (nth ii patb) ")")
		 (strcat "img" (itoa ii))
	)
	(progn
	  (play_path_sld (strcat "acad(" (nth ii patb) ")") (strcat "img" (itoa ii)))
	)
      )
      (action_tile
	(strcat "img" (itoa ii))
	"(setq pat (dopat jj))"
      )
      (setq ii (1+ ii))
    )
    (action_tile "prev" "(setq jj (prev jj))")
    (action_tile "next" "(setq jj (next jj))")
    (action_tile "cancel" "(done_dialog 0)")
    (setq what1 (start_dialog))
    (if	(= what1 1)
      (progn
	(setq ??img_sty pat)
	(if (= ??ta_style 0)
	  (playsld (strcat "dpat(" ??img_sty ")") "lm_img")
	  (progn
	    (play_path_sld (strcat "acad(" ??img_sty ")") "lm_img")
	  )
	)
      )
    )
  )

;;;显示所选列表项的数据内容
  (defun ?dl_lmjg_sub3 (val / num name1	chick1 ta_name1	ta_sca1	ta_ang1
			x y tasjb)
    (if	(and val (/= val ""))
      (progn
	(setq num      (read val)
	      tasjb    (nth num ??sj_list)
	      name1    (car tasjb)
	      chick1   (cadr tasjb)
	      ta_name1 (car (nth 2 tasjb))
	      ta_ang1  (cadr (nth 2 tasjb))
	      ta_sca1  (caddr (nth 2 tasjb))
	)
	(set_tile "lm_name" name1)
	(set_tile "lm_chick" (rtos chick1 2 1))
	(set_tile "tasz_ang" (rtos ta_ang1 2 1))
	(set_tile "tasz_sca" (rtos ta_sca1 2 1))
	(if (##getindex ta_name1 patbuser)
	  (playsld (strcat "dpat(" ta_name1 ")") "lm_img")
	  (progn
	    (play_path_sld (strcat "acad(" ta_name1 ")") "lm_img")
	  )
	)
      )
    )
  )

  ;;读数据返回数据表(名称 厚度 (图案名 图案角度 图案比例))
  (defun ?dl_lmjg_sub4
	 (/ name chick ta_name ta_ang ta_sca loop sjlis list2)
    (setq name	  (get_tile "lm_name")
	  chick	  (get_tile "lm_chick")
	  ta_name ??img_sty
	  ta_ang  (get_tile "tasz_ang")
	  ta_sca  (get_tile "tasz_sca")
	  loop	  t
    )
    (cond
      ((or (null name) (= "" (strtrim name)))
       (setq loop nil)
       (set_tile "error" "名称不能为空")
      )
      ((chknum 0.0 chick)
       (setq loop nil)
       (set_tile "error" "厚度必须为正实数")
      )
      ((chknum nil ta_ang)
       (setq loop nil)
       (set_tile "error" "图案角度必须为正实数")
      )
      ((chknum 0.0 ta_sca)
       (setq loop nil)
       (set_tile "error" "图案比例须为正实数")
      )
    )
    (if	(null loop)
      (setq sjlis nil)
      (progn
	(setq ta_ang (?pd_dopt ta_ang)
	      ta_sca (?pd_dopt ta_sca)
	      chick  (?pd_dopt chick)
	)
	(setq list2 (read (ppsgetcfg "dl_lmjgszb")))
	(setq list2 (lismod list2 2 (read ta_ang))
	      list2 (lismod list2 3 (read ta_sca))
	)
	(ppssetcfg "dl_lmjgszb" (listoa list2))
	(setq sjlis (list name
			  (read chick)
			  (list ta_name (read ta_ang) (read ta_sca))
		    )
	)

      )
    )
    sjlis
  )

;;;add list_box
  (defun ?sub_add (/ sjb xx)
    (if	(setq sjb (?dl_lmjg_sub4))
      (progn
	(setq ??sj_list	(append ??sj_list (list sjb))
	      sjb	nil
	)
	(foreach xx ??sj_list
	  (setq sjb (append sjb (list (car xx))))
	)
	($w_add_list "lm_jglist" sjb)
      )
    )
  )

;;;del list_box
  (defun ?sub_del (/ unm sjb xx)
    (setq num (get_tile "lm_jglist"))
    (if	(or (= num "") (null num))
      (set_tile "error" "没有选中要删除的项")
      (progn
	(setq num	(read num)
	      ??sj_list	(del_item num ??sj_list)
	      sjb	nil
	)
	(if (null ??sj_list)
	  (setq sjb '(""))
	  (foreach xx ??sj_list
	    (setq sjb (append sjb (list (car xx))))
	  )
	)
	($w_add_list "lm_jglist" sjb)
      )
    )
  )

;;;up list_box
  (defun ?sub_up (/ unm sjb xx)
    (setq num (get_tile "lm_jglist"))
    (if	(or (= num "") (null num))
      (set_tile "error" "没有选中要上移的项")
      (progn
	(setq num (read num))
	(if ??sj_list
	  (if (> num 0)
	    (progn
	      (setq sjb	      (nth num ??sj_list)
		    ??sj_list (del_item num ??sj_list)
		    ??sj_list (add_item_n (1- num) ??sj_list sjb)
		    sjb	      nil
	      )
	      (foreach xx ??sj_list
		(setq sjb (append sjb (list (car xx))))
	      )
	      ($w_add_list "lm_jglist" sjb)
	    )
	  )
	)
      )
    )
  )

;;;down list_box
  (defun ?sub_down (/ unm sjb xx len)
    (setq num (get_tile "lm_jglist"))
    (if	(or (= num "") (null num))
      (set_tile "error" "没有选中要下移的项")
      (progn
	(setq num (read num))
	(if ??sj_list
	  (progn
	    (setq len (1- (length ??sj_list)))
	    (if	(< num len)
	      (progn
		(setq sjb	(nth num ??sj_list)
		      ??sj_list	(del_item num ??sj_list)
		      ??sj_list	(add_item num ??sj_list sjb)
		      sjb	nil
		)
		(foreach xx ??sj_list
		  (setq sjb (append sjb (list (car xx))))
		)
		($w_add_list "lm_jglist" sjb)
	      )
	    )
	  )
	)
      )
    )
  )

;;;check main function
  (defun ?chksj	(/ dw drawsca drawid loop lis1)
    (if	(or (null ??sj_list) (= "" ??sj_list))
      (progn
	(setq loop nil)
	(set_tile "error" "列表中没有加入数据项")
      )
      (progn
	(setq dw (get_tile "lm_seldw"))
	(if (eq "lm_dwcm" dw)
	  (setq dw 0)
	  (setq dw 1)
	)
	(setq drawsca (get_tile "lm_scale")
	      drawid  (get_tile "lm_twid")
	      loop    t
	)
	(cond
	  ((chknum 0.0 drawsca)
	   (setq loop nil)
	   (set_tile "error" "没有设置绘图比例")
	  )
	  ((chknum 0.0 drawid)
	   (setq loop nil)
	   (set_tile "error" "没有设置绘图宽度")
	  )
	)
      )
    )
    (if	loop
      (progn
	(setq drawsca (?pd_dopt drawsca)
	      drawid  (?pd_dopt drawid)
	)
	(setq lis1 (read (ppsgetcfg "dl_lmjgszb")))
	(setq lis1 (lismod lis1 0 dw)
	      lis1 (lismod lis1 1 (read drawsca))
	      lis1 (lismod lis1 4 (read drawid))
	)
	(ppssetcfg "dl_lmjgszb" (listoa lis1))
      )
    )
    loop
  )

;;;绘图
  (defun ?drawing (pt	    sjlistb  /	      sca      txth1
		   name	    chick    ta_name  ta_ang   tempsjb
		   ta_sca   ta_clr   dw	      drawsca  drawid
		   oldplwid p1	     p2	      p3       xx
		   pta	    pt1	     pt2      ?drawing_bz
		   ss	    nn	     oldhpang oldhpscale
		   len1	    len2     sca1     txth2
		  )
;;;标注尺寸 txth2 sca is 全局变量
    (defun ?drawing_bz (ptb val / pt1 tt pt2 pt3 oldwid)
      (setq val	(rtos val)
	    val	(Dl_TrimRight0 val)
      )
      (command ".line" (car ptb) (cadr ptb) "")
      (setq pt1	(midpt (car ptb) (cadr ptb))
	    pt1	(polar pt1 (- 0.0 pi) (/ txth1 4.0))
      )
      (setq oldwid (getvar "plinewid"))
      (setvar "plinewid" (* sca 0.25))
      (foreach tt ptb
	(setq pt2 (polar tt (dtor 135.0) (/ txth1 4.0))
	      pt3 (polar tt (dtor -45.0) (/ txth1 4.0))
	)
	(command ".pline" pt2 pt3 "")
	(setq pt2 (polar tt pi txth1)
	      pt3 (polar tt 0.0 txth1)
	)
	(command ".line" pt2 pt3 "")
      )
      (setvar "plinewid" oldwid)
      (styrem)
      (command ".text" "j" "bc" pt1 txth2 90 val)
    )
    (setq pta	  pt
	  sca	  (/ 1.0 (DL_GetDrawingFactor))
	  sca1	  sca
	  txth1	  (Dl_GetTextHeight)
	  tempsjb (read (ppsgetcfg "dl_lmjgszb"))
	  dw	  (car tempsjb)
	  drawsca (cadr tempsjb)
	  drawid  (nth 4 tempsjb)
    )
    (cond
      ((< txth1 2.0) (setq txth2 (* sca 2.5)))
      ((> txth1 4.0) (setq txth2 (* sca 3.0)))
      (t
       (setq txth2 (* sca txth1))
      )
    )
    (setq txth1 (* 1.5 txth2))
    (setq sca (* (/ 1000.0 drawsca) sca))
    (if	(= dw 0)
      (setq sca (/ sca 100.0))
      (setq sca (/ sca 1000.0))
    )
    (setq oldplwid (getvar "plinewid"))
    (setvar "plinewid" (* 0.1 sca))

    (foreach xx	sjlistb
      (setq name    (car xx)
	    chick   (cadr xx)
	    tempsjb (caddr xx)
	    ta_name (car tempsjb)
	    ta_ang  (cadr tempsjb)
	    ta_sca  (* sca1 (caddr tempsjb))
      )
      (setq p1 (polar pta 0.0 (* sca drawid))
	    p2 (polar p1 (* pi -0.5) (* sca chick))
	    p3 (polar pta (* pi -0.5) (* sca chick))
      )
      (command ".pline" pta p1 p2 p3 "c")
      (setq pta	p3
	    ss	(ssget "l")
      )
      (setq pt1	(polar p1 0.0 (* 2.2 txth1))
	    pt2	(polar p2 0.0 (* 2.2 txth1))
      )
      (?drawing_bz (list pt1 pt2) chick)
      (command ".text"
	       (polar (polar (midpt pt1 pt2) 0.0 txth1)
		      (* -0.5 pi)
		      (/ txth1 2.0)
	       )
	       txth1
	       0.0
	       name
      )
      (setq nn (##getindex ta_name patbuser))
      (if (null nn)
	(progn
	  (setq nn (##getindex ta_name patbacad))
	  (command ".hatch" ta_name ta_sca ta_ang ss "")
	)
	(progn
	  (if (not (or (= ta_name "") (null ta_name)))
	    (progn
	      (setq oldhpang   (getvar "hpang")
		    oldhpscale (getvar "hpscale")
	      )
	      (setvar "hpang" (* (/ ta_ang 180.0) pi))
	      (setvar "hpscale" ta_sca)
	      (mkpat "dzta" nn ss "N")
	      (setvar "hpang" oldhpang)
	      (setvar "hpscale" oldhpscale)
	    )
	  )
	)
      )
    )
    (command ".text"
	     (polar (polar pt2 0.0 txth1)
		    (* -0.5 pi)
		    (* txth1 1.5)
	     )
	     txth1
	     0.0
	     "土基"
    )
    (setvar "plinewid" oldplwid)
    (setq len1 (/ (* sca drawid) 6.0)
	  pt1  (polar pta 0.0 len1)
    )
    (repeat 2
      (command ".line"
	       pt1
	       (polar pt1 (dtor -135) (* 0.7 len1))
	       ""
      )
      (setq pt2 (polar pt1 0.0 (/ len1 4.0)))
      (command ".copy" (entlast) "" pt1 pt2)
      (setq pt1 (polar pt2 0.0 (/ len1 4.0)))
      (command ".copy" (entlast) "" pt2 pt1)
      (command ".line" pt1 (polar pt1 (dtor -45) (* 0.4 len1)) "")
      (setq pt2 (polar pt1 (dtor -135) (/ len1 6.0)))
      (command ".copy" (entlast) "" pt1 pt2)
      (setq pt1 (polar pt2 (dtor -135) (/ len1 6.0)))
      (command ".copy" (entlast) "" pt2 pt1)
      (setq pt1 (polar pta 0.0 (* 2.1 len1)))
    )
  )

  ;;main function
  (HY_SV)
  (HY_Set0)
  (HY_UndoM)
  (setq szlist (ppsgetcfg "dl_lmjgszb"))
;;;检查cfg文件，如无"dl_lmjgszb"变量，设一个。
;;;"(单位 绘图比例 图案角度 图案比例 绘图宽度)"
  (if (or (= szlist "nil") (null szlist) (= szlist ""))
    (progn
      (setq szlist (list 0 10 0.0 1.0 50))
      (ppssetcfg "dl_lmjgszb" (listoa (list 0 10 0.0 1.0 50)))
    )
    (setq szlist (read szlist))
  )
  (setq	patbuser '("dpat00"   "dpat01"	 "dpat02"   "dpat03"
		   "dpat04"   "dpat05"	 "dpat06"   "dpat07"
		   ""	      ""	 ""	    ""
		  )
  )
  (setq	patbacad '("angle"     "ansi31"	   "ansi32"    "ansi33"
		   "ansi34"    "ansi35"	   "ansi36"    "ansi37"
		   "ansi38"    "ar-b816"   "ar-b816c"  "ar-b88"
		   "ar-brelm"  "ar-brstd"  "ar-conc"   "ar-hbone"
		   "ar-parq1"  "ar-rroof"  "ar-rshke"  "ar-sand"
		   "box"       "brass"	   "brick"     "brstone"
		   "clay"      "cork"	   "cross"     "dash"
		   "dolmit"    "dots"	   "earth"     "escher"
		   "flex"      "grass"	   "grate"     "hex"
		   "honey"     "hound"	   "insul"     "line"
		   "mudst"     "net"	   "net3"      "plast"
		   "plasti"    "sacncr"	   "square"    "stars"
		   "steel"     "swamp"	   "trans"     "triang"
		   "zigzag"    ""	   ""	       ""
		   ""	       ""	   ""	       ""
		  )
  )
  (setq	??img_sty  "dpat01"
	dcl_id	   (szdl_load_dlg "dl_lmjg")
	what	   4
	patb	   patbuser
	??ta_style 0
  )
  (while (> what 2)
    (if	(not (new_dialog "dl_lmjg" dcl_id))
      (exit)
    )
    (if	(= what 4)
      (progn
	(mode_tile "lm_name" 2)
	(set_tile "lm_twid" (rtos (nth 4 szlist) 2 1))
	(set_tile "lm_scale" (rtos (nth 1 szlist) 2 1))
	(if (= 0 (nth 0 szlist))
	  (set_tile "lm_dwcm" "1")
	  (set_tile "lm_dwmm" "1")
	)
	(set_tile "tasz_sca" (rtos (nth 3 szlist) 2 1))
	(set_tile "tasz_ang" (rtos (nth 2 szlist) 2 1))
	(setq what 3)
      )
    )
    (playsld (strcat "dpat(" ??img_sty ")") "lm_img")
;;;    (action_tile
;;;      "zk_name"
;;;      "(errnil)(if(read(setq initname (dlwzedit \"dcl\")))(set_tile \"lm_name\" initname))"
;;;    )
    (action_tile "lm_dyta" "(setq patb patbuser ??ta_style 0)")
    (action_tile "lm_syta" "(setq patb patbacad ??ta_style 1)")
    (action_tile "lm_selta" "(?dl_lmjg_sub1)")
    (action_tile "add" "(?sub_add)")
    (action_tile "del" "(?sub_del)")
    (action_tile "up" "(?sub_up)")
    (action_tile "down" "(?sub_down)")
    (action_tile "lm_jglist" "(?dl_lmjg_sub3 $value)")
    (action_tile "accept" "(if (?chksj)(done_dialog 1))")
    (setq what (start_dialog))
    (if	(= what 1)
      (progn
;;;lay 挂时再设 (DL_MakeLayer ****)
	(initget 1)
	(setq pt1 (getpoint "\n 确定图的位置:"))
	(?drawing pt1 ??sj_list)
      )
    )
  )
  (unload_dialog dcl_id)
  (HY_Set1)
  (HY_RV)
  (princ)
)

;;
(defun ?pd_dopt	(str /)
  (setq str (strtrim str))
  (if (and (= 'STR (type str)) (/= str ""))
    (if	(= (ascii (substr str 1 1)) 46)
      (setq str (strcat "0" str))
    )
  )
  str
)

;;;
(defun $w_add_list (xc_n xc_strb)				;xc_n : tile_name, xc_strb : string_list
	(start_list xc_n)
	(mapcar 'add_list xc_strb)
	(end_list)
)
(princ)
