;;;=============================板块检查设置=======================
(defun $jck_bkjc_sz (/         $in_act_tile        $in_chk_cs          w_odsz    w_sz
                     w_vb      w_szb     w_om1     w_om23    w_om4     w_tb1     w_tb2
                     w_idcl    w_kzzb    w_what
                    )
;;;内部子函数
  (defun $in_act_tile (xc_key)
    (cond
      ((= xc_key "jcmj")
       (setq w_om1 (- 1 w_om1))
       (mode_tile "maxs" w_om1)
      )
      ((= xc_key "jcbc")
       (set_tile "jcbb" (get_tile "jcbc"))
       (setq w_om23 (- 1 w_om23))
       (mode_tile "minsl" w_om23)
       (mode_tile "maxbl" w_om23)
      )
      ((= xc_key "jcbb")
       (set_tile "jcbc" (get_tile "jcbb"))
       (setq w_om23 (- 1 w_om23))
       (mode_tile "minsl" w_om23)
       (mode_tile "maxbl" w_om23)
      )
      ((= xc_key "jcnb")
       (setq w_om4 (- 1 w_om4))
       (mode_tile "maxgc" w_om4)
      )
    )
  )
;;;检查参数
  (defun $in_chk_cs (/ jcmj jcbc jcbb jcnb maxs minsl maxbl maxgc w_maxs w_mnsl w_mxbl w_mxgc
                     w_ok w_itms)
;;;w_tb1--w_tb2--w_odsz 在主函数中定义
    (mapcar '(lambda (in_x) (set (read in_x) (get_tile in_x)))
            w_tb1
    )
    (mapcar '(lambda (in_x) (set (read in_x) (get_tile in_x)))
            w_tb2
    )
    (cond
      ((and (= jcmj "1")
            (or (null (distof maxs)) (<= (read maxs) 0))
       )
       (set_tile "error" "允许最大板块面积必须为大于零的实数!")
      )
      ((and (= jcbc "1")
            (or (null (distof minsl)) (<= (read minsl) 0))
       )
       (set_tile "error" "允许最小板块边长必须为大于零的实数!")
      )
      ((and (= jcbb "1")
            (or (null (distof maxbl)) (<= (read maxbl) 1))
       )
       (set_tile "error" "允许最大边长比例必须为大于一的实数!")
      )
      ((and (= jcnb "1")
            (or (null (distof maxgc)) (< (read maxgc) 0))
       )
       (set_tile "error" "允许最大角点高差必须为大于等于零的实数!")
      )
      (t
       (setq w_ok t)
      )
    )
    (setq w_itms 0)
    (if (= jcmj "1")
      (setq w_itms 1
            w_maxs (read maxs)
      )
      (setq w_maxs (nth 1 w_odsz))
    )
    (if (= jcbc "1")
      (setq w_itms (+ w_itms 2)
            w_mnsl (read minsl)
      )
      (setq w_mnsl (nth 2 w_odsz))
    )
    (if (= jcbb "1")
      (setq w_mxbl (read maxbl))
      (setq w_mxbl (nth 3 w_odsz))
    )
    (if (= jcnb "1")
      (setq w_itms (+ w_itms 4)
            w_mxgc (read maxgc)
      )
      (setq w_mxgc (nth 4 w_odsz))
    )
    (if w_ok
      (list w_itms w_maxs w_mnsl w_mxbl w_mxgc)
      nil
    )
  )
;;;主函数--初始化
  (if (null (setq w_odsz (DL_GetPrjVal "JCK_BKJCKZZB")))
    (setq w_odsz (list 3 25.0 0.5 3.0 1.0))
    (setq w_odsz (read w_odsz))
  )
  (setq w_sz (car w_odsz)
        w_vb (cdr w_odsz)
  )
  (setq w_vb (mapcar '(lambda (in_x) (Dl_TrimRight0 (rtos in_x 2 4))) w_vb))
  (cond
    ((= w_sz 1)
     (setq w_szb  (list "1" "0" "0" "0")
           w_om1  0
           w_om23 1
           w_om4  1
     )

    )
    ((= w_sz 2)
     (setq w_szb  (list "0" "1" "1" "0")
	   w_om1  1
           w_om23 0
	   w_om4  1
     )
    )
    ((= w_sz 3)
     (setq w_szb  (list "1" "1" "1" "0")
           w_om1  0
           w_om23 0
           w_om4  1
     )
    )
    ((= w_sz 4)
     (setq w_szb  (list "0" "0" "0" "1")
           w_om1  1
           w_om23 1
           w_om4  0
     )
    )
    ((= w_sz 5)
     (setq w_szb  (list "1" "0" "0" "1")
           w_om1  0
           w_om23 1
           w_om4  0
     )
    )
    ((= w_sz 6)
     (setq w_szb  (list "0" "1" "1" "1")
           w_om1  1
           w_om23 0
           w_om4  0
     )
    )
    ((= w_sz 7)
     (setq w_szb  (list "1" "1" "1" "1")
           w_om1  0
           w_om23 0
           w_om4  0
     )
    )
  )
  (setq w_tb1 (list "jcmj" "jcbc" "jcbb" "jcnb")
        w_tb2 (list "maxs" "minsl" "maxbl" "maxgc")
  )
  (setq w_idcl (pub_display_dlg "jck_bkjc" "jckbkjcsz"))
  (mapcar 'set_tile w_tb1 w_szb)
  (mapcar 'set_tile w_tb2 w_vb)
  (mapcar 'mode_tile
          w_tb2
          (list w_om1 w_om23 w_om23 w_om4)
  )
  (action_tile "jcmj" "($in_act_tile $key)")
  (action_tile "jcbc" "($in_act_tile $key)")
  (action_tile "jcbb" "($in_act_tile $key)")
  (action_tile "jcnb" "($in_act_tile $key)")
  (action_tile
    "accept"
    "(if (setq w_kzzb ($in_chk_cs)) (done_dialog 1))"
  )
  (action_tile "cancel" "(done_dialog 0)")
  (setq w_what (start_dialog))
  (if (= w_what 1)
    (progn
      ;;(print w_kzzb) (getpoint "xxxxxxxxxxxxxx")
      ;;($ppssetini "JCK_BKJCKZZB" w_kzzb)
      (DL_SetPrjVal "JCK_BKJCKZZB" (HY_Lst2Str w_kzzb))
    )
  )
  (unload_dialog w_idcl)
  (princ)
)
;;;==============================板块检查主函数===============================
(defun $jck_bkjc (/         w_ssde    w_olderr  w_kzzb    w_what    w_kzmj    w_kzbc
                  w_kzbb    w_kzgc    w_txth     w_jdss    w_mjmk    w_bcmk
                  w_bbmk    w_nbmk    w_nobg    w_bkss    w_zmd     w_jde     w_jdpt
                  w_llpt    w_rrpt    w_bypb    w_byp     w_tme     w_endp
                  w_bke     w_jcjg    w_bjss    w_bje     w_ptb
                  $in_bkjc_error      w_layb    w_colr    w_odos
                 )
;;;出错处理
  (defun $in_bkjc_error (msg)
;;    (command "linetype" "s" "bylayer" "")
;;    (setvar "cecolor" "bylayer")
;;    (command ".ucs" "w")
;;    (command ".layer" "s" "PP-COM" "")
    (if (setq w_ssde (ssget "x" '((8 . "PP-DL-JCKFZ"))))
      (command "_.erase" w_ssde "")
    )
    (setq w_ssde nil)
    (if (setq w_ssde (ssget "x" '((8 . "PP-DL-JCKJCBZ"))))
      (command "_.erase" w_ssde "")
    )
    (setq w_ssde nil)
    ($jck_open_lay "ALL" "t")
    ($jck_open_lay "ALL" "on")
;;    (HY_RV)
;;    (pub_re_var)
;;    (if (or (= msg "Function cancelled")
;;            (= msg "quit / exit abort")
;;        )
;;      (princ)
;;      (princ msg)
;;    )
;;    (setq *error* w_olderr w_olderr nil)
    (princ)
  )
;;;
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (if (null $ptoe)
    (#ppls "pppp")
  )
  (pusherr $in_bkjc_error)
 ;;; (setq w_olderr *error* *error* $in_bkjc_error)
  (pub_save_var)
;;;读控制指标
  (if (null (setq w_kzzb (DL_GetPrjVal "JCK_BKJCKZZB")))
    (setq w_kzzb (list 3 25.0 0.5 3.0 1.0))
    (setq w_kzzb (read w_kzzb))
  )
  (setq w_what (nth 0 w_kzzb)
;;;检查项目控制--全局量
        w_kzmj (nth 1 w_kzzb)
;;;控制面积--全局量
        w_kzbc (nth 2 w_kzzb)
;;;控制边长--全局量
        w_kzbb (nth 3 w_kzzb)
;;;控制边长之比--全局量
        w_kzgc (nth 4 w_kzzb)
;;;控制扭板高差--全局量
  )
  (setq w_txth 0.5)
;;;搜索所有角点
  (setq w_jdss (ssget "x" '((0 . "CIRCLE") (8 . "PP-DL-JCKPT"))))
  (if w_jdss
    (progn
      (setq w_layb
             (list
               "PP-DL-JCKJCBZ"
               "PP-DL-JCKBJ"
              "PP-DL-JCKBK"
              "PP-DL-JCKND"
              "PP-DL-JCKFZ"
              "ROAD-1"
        )
      )
      ($jck_open_lay w_layb "t")
      ($jck_open_lay w_layb "on")
;;;如发现原有检查标志全部删除
      (if (setq w_ssde (ssget "x" '((8 . "PP-DL-JCKFZ"))))
        (command "_.erase" w_ssde "")
      )
      (if (setq w_ssde (ssget "x" '((8 . "PP-DL-JCKJCBZ"))))
        (command "_.erase" w_ssde "")
      )
      (princ "\n正在检查,请稍候...")
      (DL_MakeLayer "PP-DL-JCKFZ")
      ($jck_close_lay (cdr w_layb) "off")
      (setq w_bkss (ssadd)
            w_zmd  15.0
      )
;;;要检查的板块选择集
;;      (setq w_odos (getvar "osmode"))
;;      (setvar "osmode" 0)
      (while (> (sslength w_jdss) 0)
        (&wait_bz)
        (setq w_jde  (ssname w_jdss 0)
              w_jdpt (cdr (assoc 10 (entget w_jde)))
              w_llpt (polar w_jdpt (* 0.25 pi) w_zmd)
              w_rrpt (polar w_jdpt (* 1.25 pi) w_zmd)
        )
        (ssdel w_jde w_jdss)
        (setq w_bypb ($jck_jd_pfpb w_jde))
        (command "_.zoom" w_llpt w_rrpt)
        (foreach w_byp w_bypb
          (if (ssget "f"
                     (list w_jdpt w_byp)
                     '((8 . "ROAD-1,PP-DL-JCKND,PP-DL-JCKBJ"))
              )
            (setq w_tme nil)
            (setq w_tme (hy_bpoly w_byp))
          )
          (if w_tme
            (progn
              (setq w_endp (bg-ypp w_tme))
              (if (ssget "wp" w_endp '((0 . "POINT") (8 . "PP-DL-JCKFZ")))
                (entdel w_tme)
                (progn
                  (command "_.point" w_byp)
                  (ssadd w_tme w_bkss)
                )
              )
            )
          )
;;;end (if w_tme
        )
;;;end foreach
      )
;;      (setvar "osmode" w_odos)
;;;end while
    )
    (progn
      (setq w_bkss nil)
      (prompt "\n请先做板块处理,再做板块检查!")
    )
  )
  (if (setq w_ssde (ssget "x" '((0 . "POINT") (8 . "PP-DL-JCKFZ"))))
    (command "_.erase" w_ssde "")
  )
;;;如有边界调用检查函数 $jck_do_bkjc
      (setq w_mjmk 0
            w_bcmk 0
            w_bbmk 0
            w_nbmk 0
            w_nobg 0
            w_colr 0
      )
;;;不合格板块数--初值为零8/20/99
  (setq w_bjss (ssget "x" '((0 . "LWPOLYLINE") (8 . "PP-DL-JCKBJ"))))
  (if w_bjss
    (progn
      (setq w_bje (ssname w_bjss 0)
            w_ptb (bg-ypp w_bje)
      )
      ($jck_zoom_ptb w_ptb)
    )
  )
  ($jck_open_lay '("PP-DL-JCKPT" "PP-DL-JCKJCBZ") "on")
  (DL_MakeLayer "PP-DL-JCKJCBZ")
  (while (and w_bkss (> (sslength w_bkss) 0))
    (setq w_bke (ssname w_bkss 0))
    (ssdel w_bke w_bkss)
    ($jck_do_bkjc w_bke)
    (entdel w_bke)
  )
  (princ "\n......OK!")
;;;检查结果显示8/20/99
  (setq w_jcjg "经检查:")
  (if (> w_mjmk 0)
    (setq w_jcjg (strcat "\n\n  有" (itoa w_mjmk) "处板块面积不合格!"))
  )
  (if (> w_bcmk 0)
    (setq w_jcjg (strcat w_jcjg "\n\n  有" (itoa w_bcmk) "处板边长不合格!"))
  )
  (if (> w_bbmk 0)
    (setq w_jcjg (strcat w_jcjg
                         "\n\n  有"
                         (itoa w_bbmk)
                         "处板边长之比不合格!"
                 )
    )
  )
  (if (> w_nbmk 0)
    (setq w_jcjg (strcat w_jcjg "\n\n  有" (itoa w_nbmk) "处角点高程不合格!"))
  )
  (if (> w_nobg 0)
    (setq w_jcjg (strcat w_jcjg "\n\n  有" (itoa w_nbmk) "处角点标高未定义!"))
  )
  (if (= (+ w_mjmk w_bcmk w_bbmk w_nbmk w_nobg) 0)
    (setq w_jcjg (strcat w_jcjg "\n\n  没发现不合格板块!"))
    (progn
      (setq w_jcjg (strcat w_jcjg
                           "\n\n  可用\"检查结果查看\"命令查看详细情况."
                   )
      )
    )
  )
  (if w_bkss (DL_MsgBox w_jcjg "板块检查结果" 0))
  ($jck_open_lay "ALL" "on")
  (setvar "clayer" "PP-COM")
  (clr_err)
 ;;;; (setq *error* w_olderr w_olderr nil)
  (HY_RV)
  (pub_re_var)
  (princ)
)
;;;由板块取得角点的顺序点表
(defun $jck_bk_jdpb (xc_bke / w_vpb w_vp w_bgpb w_1040 w_jp w_fhe w_type w_bjpb w_flst)
  (if (null pub_opb_sort)
    (#ppls "wwpublic")
  )
  (setq w_flst '((0 . "CIRCLE") (8 . "PP-DL-JCKPT")))
  (setq w_vpb (bg-ypp xc_bke))
  (foreach w_vp w_vpb
    (setq w_bgpb ($jck_tqjdbg w_vp w_flst))
    (if (equal (cadr w_bgpb) w_vp 0.001)
      (setq w_bjpb (cons w_vp w_bjpb))
    )
  )
  w_bjpb
)

;;;做板块检查----------------------------
(defun $jck_do_bkjc (xc_tme / w_bjpt w_ifok w_msgb w_inp)
;;; w_what w_kzmj w_kzbc w_kzbb w_kzgc 在主函数中定义
;;;;处理边界,使每一顶点都是板块角点
  (setq w_bjpt ($jck_bk_jdpb xc_tme)
        w_bjpt (pub_opb_sort w_bjpt)
  )
;;;w_ifok--记录是否合格--在以下函数中被修改
  (if (> (length w_bjpt) 2)
    (progn
      (setq w_ifok 0 w_msgb '())
      (cond
        ((= w_what 1)
;;;检查面积
         ($jck_jcmj)
        )
        ((= w_what 2)
;;;检查边长
         ($jck_jcbc)
        )
        ((= w_what 3)
;;;检查面积
         ($jck_jcmj)
;;;检查边长
         ($jck_jcbc)
        )
        ((= w_what 4)
;;;检查扭板
         ($jck_jcnb)
        )
        ((= w_what 5)
;;;检查面积
         ($jck_jcmj)
;;;检查扭板
         ($jck_jcnb)
        )
        ((= w_what 6)
;;;检查边长
         ($jck_jcbc)
;;;检查扭板
         ($jck_jcnb)
        )
        ((= w_what 7)
;;;检查面积
         ($jck_jcmj)
;;;检查边长
         ($jck_jcbc)
;;;检查扭板
         ($jck_jcnb)
        )
      )
;;;如果板块不合格在标志上扩展数据
      (if (> w_ifok 0)
        (progn
          (if (> w_colr 3) (setq w_colr 1) (setq w_colr (+ w_colr 1)))
          (setq w_inp (pub_ptb_inp w_bjpt))
          (command "_.hatch" "S" xc_tme "")
          (command "_.chprop" (entlast) "" "C" w_colr "")
;;;标注不合格板块
          ($jck_mark_chk w_inp w_msgb)
        )
      )
    )
  )
)
(defun $jck_jcmj (/ w_area w_txt)
;;;w_inp 在该函数的调用函数 $jck_do_bkjc 中定义
  (command "_.area" "o" xc_tme)
  (setq w_area (getvar "area"))
  (if (> w_area w_kzmj)
    (progn
      (setq w_mjmk (+ w_mjmk 1)
            w_ifok (+ w_ifok 1)
            w_txt  (strcat "L=" (rtos w_area 2 2))
            w_msgb (cons w_txt w_msgb)
      )
    )
  )
)
;;;检查边长、边比-----------------------------
(defun $jck_jcbc (/ w_tmpb w_bcb w_maxb w_minb w_bcbl w_txt w_bjpb)
;;;w_bjpt--在该函数的调用函数 $jck_do_bkjc 中定义
  (setq w_bjpb (pub_ptb_filter w_bjpt 0.01))
  (setq w_tmpb (append (cdr w_bjpb) (list (car w_bjpb))))
  (setq w_bcb  (mapcar 'distance w_bjpb w_tmpb)
        w_maxb (apply 'max w_bcb)
        w_minb (apply 'min w_bcb)
        w_bcbl (/ w_maxb w_minb)
  )
  (if (< w_minb w_kzbc)
    (setq w_bcmk (+ w_bcmk 1)
          w_ifok (+ w_ifok 2)
          w_txt  (strcat "L=" (rtos w_minb 2 3))
          w_msgb (cons w_txt w_msgb)
    )
  )
  (if (> w_bcbl w_kzbb)
    (progn
      (setq w_bbmk (+ w_bbmk 1)
            w_ifok (+ w_ifok 4)
            w_txt  (strcat "I=" (rtos w_bcbl 2 2))
            w_msgb (cons w_txt w_msgb)
      )
    )
  )
)
;;;检查扭板----------------------------
(defun $jck_jcnb (/ w_bgb w_ii w_blen w_pt w_bg w_bg1 w_pt1 w_bg2 w_pt2 w_bg3 w_pt3 w_pmfc w_jp
                  w_llbg w_gc w_txt w_bjpb w_jang)
  ;;;w_bjpt--在该函数的调用函数 $jck_do_bkjc 中定义
  (setq w_bjpb (pub_ptb_filter w_bjpt 0.5))
  (setq w_bgb  '()
        w_ii   0
        w_blen (length w_bjpb)
  )
;;;构造标高点表
  (while (< w_ii w_blen)
    (setq w_pt (nth w_ii w_bjpb)
          w_ii (1+ w_ii)
    )
    (setq w_bg (car
                 ($jck_tqjdbg w_pt '((0 . "CIRCLE") (8 . "PP-DL-JCKPT")))
               )
    )
    (if (and w_bg (/= w_bg "0"))
      (setq w_bgb (cons (list w_bg w_pt) w_bgb))
      (setq w_ii   w_blen
            w_msgb (cons "标高定义不完整!" w_msgb)
            w_bgb  nil
            w_ifok (+ w_ifok 8)
            w_nobg (+ w_nobg 1)
      )
    )
  )
  (if (> (length w_bgb) 3)
;;;定义标高的点多于三个-->求平面方程
    (progn
      (setq w_bg1 (car (nth 0 w_bgb))
            w_pt1 (cadr (nth 0 w_bgb))
            w_bg2 (car (nth 1 w_bgb))
            w_pt2 (cadr (nth 1 w_bgb))
            w_bg3 (car (nth 2 w_bgb))
            w_pt3 (cadr (nth 2 w_bgb))
            w_bgb (cddr w_bgb)
            w_jang ($jiajiao w_pt3 w_pt1 w_pt2)
      )
      (if (or (> (rtod w_jang) 165.0) (< (rtod w_jang) 15.0))
        (progn
          (setq w_bg3 (car (cadr w_bgb))
                w_pt3 (cadr (cadr w_bgb))
                w_bgb (cons (car w_bgb) (cddr w_bgb))
                w_jang ($jiajiao w_pt3 w_pt1 w_pt2)
          )
          (if (or (> (rtod w_jang) 165.0) (< (rtod w_jang) 15.0))
            (setq w_pmfc nil)
            (setq w_pt1  (z_p (float w_bg1) w_pt1)
                  w_pt2  (z_p (float w_bg2) w_pt2)
                  w_pt3  (z_p (float w_bg3) w_pt3)
                  w_pmfc (pub_3d_pmfc w_pt1 w_pt2 w_pt3)
            )
          )
        )
        (setq w_pt1  (z_p (float w_bg1) w_pt1)
              w_pt2  (z_p (float w_bg2) w_pt2)
              w_pt3  (z_p (float w_bg3) w_pt3)
              w_pmfc (pub_3d_pmfc w_pt1 w_pt2 w_pt3)
              w_bgb  (cdr w_bgb)
        )
      )
    )
    (setq w_pmfc nil)
  )
  (if w_pmfc
    (while (> (length w_bgb) 0)
      (setq w_bg   (car w_bgb)
            w_bgb  (cdr w_bgb)
            w_jp   (cadr w_bg)
            w_llbg (pub_pmfc_bg w_jp w_pmfc)
            w_gc   (abs (* (- (car w_bg) w_llbg) 1000.0))
      )
;;;定义的标高与理论标高之差
      (if (> w_gc w_kzgc)
        (setq w_bgb  nil
              w_nbmk (+ w_nbmk 1)
              w_txt  (strcat "@H=" (rtos w_gc 2 3))
              w_msgb (cons w_txt w_msgb)
              w_ifok (+ w_ifok 16)
        )
      )
    )
  )
)

;;;标注不合格板块------------------
(defun $jck_mark_chk (xc_inp xc_msgb / w_offd w_txth w_sp w_msg w_inp w_odos)
  (setq w_offd (/ 0.5 (DL_GetDrawingFactor))
        w_txth (/ 1.0 (DL_GetDrawingFactor))
  )
  (styrem)
;;  (setq w_odos (getvar "osmode"))
;;  (setvar "osmode" 0)
  (setq w_sp xc_inp)
  (foreach w_msg xc_msgb
    (setq w_sp (polar w_sp (* 0.5 pi) w_offd))
    (command "_.text" w_sp w_txth 0 w_msg)
    (command "_.chprop" (entlast) "" "C" 210 "")
  )
  (setq w_sp  (polar w_sp (* 0.5 pi) w_offd)
        w_sp  (polar w_sp pi w_offd)
        w_inp (polar xc_inp pi w_offd)
  )
  (command "_.line" w_inp w_sp "")
  (command "_.chprop" (entlast) "" "C" 70 "")
;;  (setvar "osmode" w_odos)
)

;;;检查结果查看-------------------------
(defun $jck_jcjgck (/ w_flst w_jlss w_jle w_jlpt w_p1 w_p2 w_kwrd w_smwz w_tkm w_dele w_ffpt
                    w_psc)
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (pub_save_var)
  (setq w_flst '((0 . "LINE") (8 . "PP-DL-JCKJCBZ"))
        w_tkm  "dl-c"
  )
  (setq w_jlss (ssget "x" w_flst))
  (if (null w_jlss)
    (prompt "\n检查结果记录没找到!")
    (progn
      (setq w_smwz
             "S= 表示该板块面积;\nI= 表示该板块长边与短边之比;\nL= 表示最短边边长;\n@H= 表示角点最大高差."
      )
      (DL_MsgBox w_smwz "符号说明" 0)
      (command "_.view" "s" "w_oldview")
      (styrem)
      (HY_SV)
      (while (> (sslength w_jlss) 0)
        (setq w_jle  (ssname w_jlss 0)
              w_jlpt (p# (cdr (assoc 10 (entget w_jle))))
              w_p1   (polar w_jlpt (* 0.25 pi) 8.0)
              w_p2   (polar w_jlpt (* 1.25 pi) 8.0)
        )
        (ssdel w_jle w_jlss)
        (command "_.zoom" w_p1 w_p2)
        (if w_dele
          (progn
            (command "_.move" w_dele "" w_ffpt w_jlpt)
            (setq w_ffpt w_jlpt)
          )
          (progn
            (setq w_psc (dw-psc 29.5))
            (szdl_ins_sysblk w_tkm w_jlpt w_psc w_psc 0)
            (setq w_dele (entlast)
                  w_ffpt w_jlpt
            )
          )
        )
        (initget "E")
        (setq w_kwrd (getkword "\n结束 E / <下一个记录>:"))
        (if (= w_kwrd "E")
          (setq w_jlss (ssadd))
        )
      )
      (HY_RV)
      (command "_.view" "r" "w_oldview")
    )
  )
  (if (setq w_dele (ssget "x" '((2 . "DL-C"))))
    (command "_.erase" w_dele "")
  )
  (pub_re_var)
  (princ)
)
;;;清理检查符号
(defun $jck_bkjc_ql (/ w_flst w_ssde)
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (pub_save_var)
  (setq w_flst '((8 . "PP-DL-JCKJCBZ")))
  (setq w_ssde (ssget "x" w_flst))
  (if w_ssde
    (command "_.erase" w_ssde "")
  )
  (prompt "\n检查符号已经清理完毕!")
  (pub_re_var)
  (princ)
)
;;--------------------------
;; 冻/锁/关某些层外所有层  "f"/"lo"/"off"
;;--------------------------
(defun $jck_close_lay (xc_layb xc_flag / w_layb w_lay curLay)
  (if (null getlay)
    (#ppls "SZDLTOOL")
  )
  (setq w_layb (getlay "*"))
  (setq curLay (getvar "clayer"))
  (command "layer")
  (foreach w_lay w_layb
    (if (or (member w_lay xc_layb) (= (strcase curLay) (strcase w_lay)))
      (princ)
      (command xc_flag w_lay)
    )
  )
  (command "")
)
;; 1996.10.15 thu
;; 解冻/锁  "t"/"u"/"on"
;;-----------------------------
(defun $jck_open_lay (xc_layb xc_flag / w_fhb w_lay curLay)
  (if (null getlay)
    (#ppls "SZDLTOOL")
  )
  (setq w_fhb (getlay "*"))
  (setq curLay (getvar "clayer"))
  (command "layer")
  (if (= xc_layb "ALL")
    (foreach w_lay w_fhb
      (command xc_flag w_lay)
    )
    (foreach w_lay w_fhb
      (if (or (member w_lay xc_layb) (= (strcase curLay) (strcase w_lay)))
        (command xc_flag w_lay)
      )
    )
  )
  (command "")
  (princ)
)
;;;求某角点周围的平分点
(defun $jck_jd_pfpb (xc_jde / w_jdpt w_bkft w_bkss w_schd w_pfpb w_goon w_ipb w_ii w_blen w_ffpt
                     w_bbpt w_pfpt w_tmpt)
  (if (or (null $pfj) (null $ptoe) (null $jiajiao))
    (#ppls "pppp")
  )
  (if (null pub_opb_sort)
    (#ppls "wwpublic")
  )
  (setq w_jdpt (cdr (assoc 10 (entget xc_jde)))
        w_bkft '((8 . "PP-DL-JCKBK"))
        w_bkss ($ptoe w_jdpt w_bkft)
        w_schd 0.25
  )
  (if (or (null w_bkss) (< (sslength w_bkss) 2))
    (setq w_pfpb nil)
    (setq w_goon 1)
  )
  (if (= w_goon 1)
    (progn
      (setq w_ipb (ipt_ess xc_jde w_bkss)
            w_ipb (mapcar 'car w_ipb)
            w_ipb (dwglq w_ipb)
      )
;;;角点圆与板块线的所有交点
      (if (< (length w_ipb) 3)
        (setq w_goon 0)
      )
    )
  )
  (if (= w_goon 1)
;;;交点多于两个 --> 构造点表
    (progn
      (setq w_ipb  (pub_opb_sort w_ipb)
;;;点表排序 --> 构成没有交叉的凸区域
            w_ipb  (append w_ipb (list (car w_ipb)))
            w_ii   0
            w_blen (- (length w_ipb) 1)
      )
      (while (< w_ii w_blen)
        (setq w_ffpt (nth w_ii w_ipb)
              w_ii   (1+ w_ii)
              w_bbpt (nth w_ii w_ipb)
        )
        (if (< (rtod ($jiajiao w_jdpt w_ffpt w_bbpt)) 165.0)
          (setq w_pfpt ($pfj w_jdpt w_ffpt w_bbpt)
                w_tmpt (polar w_jdpt (angle w_jdpt w_pfpt) w_schd)
                w_pfpb (cons w_tmpt w_pfpb)
          )
        )

      )
    )
    (setq w_pfpb nil)
  )
  w_pfpb
)

;;;生成三维板块主函数===============================
(defun $jck_3dvw (/        w_olderr w_jdss   w_layb   w_dess   w_bkss   w_zmd    w_jde
                  w_jdpt   w_llpt   w_rrpt   w_bypb   w_byp    w_tme    w_endp   w_bl
                  w_bjss   w_bje    w_ptb    w_bke    w_odos   $in_3dvw_error
                 )
;;;内部出错函数------
  (defun $in_3dvw_error (msg / w_dess w_olderr)
;;    (command "linetype" "s" "bylayer" "")
;;    (setvar "cecolor" "bylayer")
;;    (command ".ucs" "w")
    ($jck_open_lay "ALL" "on")
    (if (setq w_dess (ssget "x" '((8 . "PP-DL-JCK3D,PP-DL-JCKFZ"))))
      (command "_.erase" w_dess "")
    )
    (setq w_dess nil)
;;    (if (or (= msg "Function cancelled")
;;            (= msg "quit / exit abort")
;;        )
;;      (princ)
;;      (princ msg)
;;    )
;;    (setq *error*  w_olderr
;;          w_olderr nil
;;    )
;;    (HY_RV)
    (pub_re_var)
;;    (setvar "clayer" "PP-COM")
    (princ)
  )
;;;------
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (pub_save_var)
  (pusherr $in_3dvw_error)
  ;;;(setq w_olderr *error* *error* $in_3dvw_error)
  (setq w_jdss (ssget "x" '((0 . "CIRCLE") (8 . "PP-DL-JCKPT"))))
  (if w_jdss
    (progn
      (setq w_layb
             (list
               "PP-DL-JCK3D"
               "PP-DL-JCKBJ"
               "PP-DL-JCKBK"
               "PP-DL-JCKND"
               "PP-DL-JCKFZ"
               "ROAD-1"
             )
      )
      ($jck_open_lay w_layb "t")
      ($jck_open_lay w_layb "on")
;;;删除原有三维板块和辅助层实体
      (setq w_dess (ssget "x" '((8 . "PP-DL-JCK3D,PP-DL-JCKFZ"))))
      (if w_dess
        (command "_.erase" w_dess "")
      )
      (setq w_dess nil)
      (princ "\n正在搜索板块,请稍候...")
      (setq w_bkss (ssadd)
            w_zmd  15.0
      )
      (DL_MakeLayer "PP-DL-JCKFZ")
      ($jck_close_lay (cdr w_layb) "off")
;;;构造板块
;;      (setq w_odos (getvar "osmode"))
;;      (setvar "osmode" 0)
      (while (> (sslength w_jdss) 0)
        (&wait_bz)
        (setq w_jde  (ssname w_jdss 0)
              w_jdpt (cdr (assoc 10 (entget w_jde)))
              w_llpt (polar w_jdpt (* 0.25 pi) w_zmd)
              w_rrpt (polar w_jdpt (* 1.25 pi) w_zmd)
        )
        (ssdel w_jde w_jdss)
        (setq w_bypb ($jck_jd_pfpb w_jde))
        (command "_.zoom" w_llpt w_rrpt)
        (foreach w_byp w_bypb
          (if (ssget "f"
                     (list w_jdpt w_byp)
                     '((8 . "ROAD-1,PP-DL-JCKND,PP-DL-JCKBJ"))
              )
            (setq w_tme nil)
            (setq w_tme (hy_bpoly w_byp))
          )
          (if w_tme
            (progn
              (setq w_endp (bg-ypp w_tme))
              (if (ssget "wp" w_endp '((0 . "POINT") (8 . "PP-DL-JCKFZ")))
                (entdel w_tme)
                (progn
                  (command "_.point" w_byp)
                  (ssadd w_tme w_bkss)
                )
              )
            )
          )
;;;end (if w_tme
        )
;;;end foreach
      )
;;      (setvar "osmode" w_odos)
;;;end while
    )
    (progn
      (setq w_bkss nil)
      (prompt "\n请先做板块处理,再做板块检查!")
    )
  )
  (if (and w_bkss (> (sslength w_bkss) 0))
    (progn
      (setq w_bl (getreal "\n竖向放大系数<2.0>"))
      (if (null w_bl)
        (setq w_bl 2.0)
      )
      (setq w_bjss (ssget "x" '((0 . "LWPOLYLINE") (8 . "PP-DL-JCKBJ"))))
      (if w_bjss
        (progn
          (setq w_bje (ssname w_bjss 0)
                w_ptb (bg-ypp w_bje)
          )
          ($jck_zoom_ptb w_ptb)
        )
      )
      ($jck_open_lay '("PP-DL-JCKPT" "PP-DL-JCK3D") "on")
      (princ "\n正在构造三维板块,请稍候...")
      (while (> (sslength w_bkss) 0)
        (&wait_bz)
        (setq w_bke (ssname w_bkss 0))
        (ssdel w_bke w_bkss)
        ($jck_do_3dbk w_bke w_bl)
        (entdel w_bke)
      )
    )
  )
  (princ "\n")
  (princ "\n......OK!")
  ($jck_open_lay "ALL" "on")
  (setvar "clayer" "PP-COM")
  (clr_err)
;;  (setq *error*  w_olderr
;;        w_olderr nil
;;  )
  (pub_re_var)
  (princ)
)
;;;生成三维板块------------------
(defun $jck_do_3dbk (xc_bke xc_bl / w_bgb w_ii w_blen w_pt w_bjpb w_bg)
  (if (null pub_opb_sort)
    (#ppls "wwpublic")
  )
  (setq w_bjpb ($jck_bk_jdpb xc_bke))
  (setq w_bgb  '()
        w_ii   0
        w_blen (length w_bjpb)
  )
;;;构造标高点表
  (while (< w_ii w_blen)
    (setq w_pt (nth w_ii w_bjpb)
          w_ii (1+ w_ii)
    )
    (setq w_bg (car
                 ($jck_tqjdbg w_pt '((0 . "CIRCLE") (8 . "PP-DL-JCKPT")))
               )
    )
    (if (and w_bg (/= w_bg "0"))
      (setq w_bgb (cons (z_p (* w_bg xc_bl) w_pt) w_bgb))
      (setq w_ii  w_blen
            w_bgb nil
      )
    )
  )
  (if (> (length w_bgb) 2)
;;;    (progn
;;;      (setq w_bgb (pub_ptb_filter w_bgb 0.1))
;;;      (if (> (length w_bgb) 2)
;;;        (progn
;;;        (setq w_bgb (pub_opb_sort w_bgb))
        (mk3dm w_bgb "PP-DL-JCK3D")
;;;        )
;;;      )
;;;    )
  )
)


;;;提取角点标高--xc_pt 点或者角点实体
;;;返回值:表--(标高 角点 角点实体 标高类型) or ("0" 0 0 0)
;;;标高类型: K1 -- 一级控制点,K2 -- 二级控制点,K3 -- 自动计算点.
(defun $jck_tqjdbg (xc_pt xc_flst / w_p1 w_p2 w_jpss w_jpe w_jp w_fhe w_kzdb w_type w_ddeb w_dd
                    w_1040 w_1070 w_fhv)
  (if (listp xc_pt)
;;;如果参数 xcpt 是点
    (progn
      (setq w_p1 (polar xc_pt (* 0.25 pi) 0.5)
            w_p2 (polar xc_pt (* 1.25 pi) 0.5)
      )
      (zm2pt w_p1 w_p2)
      (setq w_jpss (ssget "f" (list w_p1 w_p2) xc_flst))
      (if w_jpss
        (if (= (sslength w_jpss) 1)
          (setq w_fhe (ssname w_jpss 0)
                w_jp  (cdr (assoc 10 (entget w_fhe)))
          )
          (progn
            (while (> (sslength w_jpss) 0)
              (setq w_jpe  (ssname w_jpss 0)
                    w_jp   (cdr (assoc 10 (entget w_jpe)))
                    w_dd   (pmdist xc_pt w_jp)
                    w_ddeb (cons (list w_dd w_jpe) w_ddeb)
              )
              (ssdel w_jpe w_jpss)
            )
            (setq w_ddeb (ptbxpx w_ddeb)
                  w_fhe  (cadr (car w_ddeb))
                  w_jp   (cdr (assoc 10 (entget w_fhe)))
            )
          )
        )
      )
    )
;;;是实体
    (setq w_fhe xc_pt)
  )
  (if w_fhe
    (progn
      (setq w_jp   (cdr (assoc 10 (entget w_fhe)))
            w_1040 (HY_QQ10xx w_fhe "JCKJDBG" 1040)
            w_1070 (HY_QQ10xx w_fhe "JCKJDBG" 1070)
      )
      (if w_1070
        (setq w_type (strcat "K" (itoa w_1070)))
        (setq w_1040 "0"
              w_type "NK"
        )
      )
      (setq w_fhv (list w_1040 w_jp w_fhe w_type))
    )
    (setq w_fhv nil)
  )
  w_fhv
)
;;;放缩点表
(defun $jck_zoom_ptb (xc_ptb / w_xxb w_yyb w_minx w_miny w_maxx w_maxy)
  (setq w_xxb  (mapcar 'car xc_ptb)
        w_yyb  (mapcar 'cadr xc_ptb)
        w_minx (- (apply 'min w_xxb) 10.0)
        w_maxx (+ (apply 'max w_xxb) 10.0)
        w_miny (- (apply 'min w_yyb) 10.0)
        w_maxy (+ (apply 'max w_yyb) 10.0)
  )
  (command "_.zoom"
           (list w_minx w_miny 0.0)
           (list w_maxx w_maxy 0.0)
  )
)
