
(defun &t_hdgx (/ xh p1 p2 p3 z1 z2 z3 di zjz xh2 an1 an2 laynam_dgx)
  ;;(setq laynam_dgx (c_pps_chglay "HY_DX_DGXS_LAYER" "laysym" "laynam"))
  (setq laynam_dgx "PP-DX-DGXS")
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "plinewid" 0.0)
  (DL_MakeLayer laynam_dgx)
  (setq xh t)
  (while xh
    (setq p1 (getpoint "\n输入第一点 /<回车退出>:"))
    (if (= p1 nil)
      (setq xh nil)
      (progn
        (initget 1)
        (setq z1 (getreal "\n输入标高:"))
        (initget 1)
        (setq p2 (getpoint p1 "\n输入第二点:"))
        (grdraw p1 p2 -1 1)
        (initget 1)
        (setq z2 (getreal "\n输入标高:"))
        (setq xh2 t)
        (while xh2
          (initget 1)
          (setq p3 (getpoint p2 "\n输入第三点:"))
          (grdraw p2 p3 -1 1)
          (setq an1 (angle p1 p3)
                an2 (angle p1 p2)
          )
          (if (or (< (abs (rem (- an1 an2) pi)) 0.01)
                  (> (abs (rem (- an1 an2) pi)) 3.13)
              )
            (progn
              (print)
              (prompt "\n三点不能在一条线上,重输!")
                                        ;(grdraw p3 p2 -1 1)
              (grdraw p2 p3 -1 1)
            )
            (setq xh2 nil)
          )
        )                               ;end of while xh2
        (initget 1)
        (setq z3 (getreal "\n输入标高:"))
        (if &var_dgj
          (progn
            (initget 6)
            (setq
              zjz (getreal
                    (strcat "\n输入等高距<" (rtos &var_dgj 2 3) ">:")
                  )
            )
            (if zjz
              (setq &var_dgj zjz)
            )
          )
          (progn
            (initget 7)
            (setq &var_dgj (getreal "\n输入等高距:"))
          )
        )
                                        ;(grdraw p3 p2 -1 1)
                                        ;(grdraw p2 p1 -1 1)
        (grdraw p1 p2 -1 1)
        (grdraw p2 p3 -1 1)
        (HY_SV)
        (&sd_dgx p1 p2 p3 z1 z2 z3 &var_dgj)
        (HY_RV)
      )
    )
  )                                     ;end of while xh
  (setvar "clayer" "PP-COM")
  (setvar "elevation" 0.0)
  (setvar "blipmode" 1)
  (setvar "cmdecho" 1)
  (princ)
)                                       ;end of defun
                                        ;
                                        ;
(defun &sd_dgx (p1    p2    p3    z1    z2    z3    &var_dgj    /
                di    ang1  ang2  ang   ix    iy    ix1   ix2   iy1
                iy2   di    z_dd  ns1   ns2   xs_z  z_s   z_e   xh2
                pt    p01   p02   pt1   pt2   pt3   dz12  dz13  dx12
                dy12  dx13  dy13  num1  unm2  wb
               )
  (setq wb  (&sd_ian p1 p2 p3 z1 z2 z3)
        ix  (car wb)
        iy  (cadr wb)
        ang (caddr wb)
        di  (cadddr wb)
  )
  (setq pt2  (interss p1
                      (polar p1 ang 1026.0)
                      p2
                      (polar p2 (+ ang (* pi 0.5)) 1026.0)
                      nil
             )
        pt3  (interss p1
                      (polar p1 ang 1026.0)
                      p3
                      (polar p3 (+ ang (* pi 0.5)) 1026.0)
                      nil
             )
        ang1 (angle p1 pt2)
        ang2 (angle p1 pt3)
  )
  (if (or (< (abs (rem (- ang1 ang2) (* pi 2.0))) 0.1)
          (> (abs (rem (- ang1 ang2) (* pi 2.0))) 6.2)
      )
    (if (> (pmdist p1 pt2) (pmdist p1 pt3))
      (setq p01 p1
            z_s z1
            p02 pt2
            z_e z2
      )
      (setq p01 p1
            z_s z1
            p02 pt3
            z_e z3
      )
    )
    (setq p01 pt2
          z_s z2
          p02 pt3
          z_e z3
    )
  )
  (setq ns1 (fix (/ z_s &var_dgj))
        ns2 (fix (/ z_e &var_dgj))
  )
  (if (/= ns1 ns2)
    (progn
      (setq ang2 (angle p01 p02)
            z_dd 0.0
      )
      (if (not (or (< (abs (rem (- ang ang2) (* pi 2.0))) 0.1)
                   (> (abs (rem (- ang ang2) (* pi 2.0))) 6.2)
               )
          )
        (setq ang (rem (+ ang pi) (* 2.0 pi)))
      )
      (if (> z_e z_s)
        (progn
          (setq xs_z 1.0)
          (if (not (equal z_s (* ns1 &var_dgj) 0.0001))
            (if (< ns1 0)
              (setq z_dd (- (* ns1 &var_dgj) z_s))
              (setq z_dd (- (* (+ ns1 1) &var_dgj) z_s))
            )
          )
        )
        (progn
          (setq xs_z -1.0)
          (if
            (not (equal z_s (* (fix (/ z_s &var_dgj)) &var_dgj) 0.0001))
             (if (> ns1 0)
               (setq z_dd (- (* ns1 &var_dgj) z_s))
               (setq z_dd (- (* (- ns1 1) &var_dgj) z_s))
             )
          )
        )
      )
      (setq xh2 t)
      (while xh2
        (setq pt (polar p01 ang (abs (/ z_dd di))))
        (setq pt1 (interss p1
                           p2
                           (polar pt (+ ang (* pi 0.5)) 1026.0)
                           pt
                           nil
                  )
              pt2 (interss p1
                           p3
                           (polar pt (+ ang (* pi 0.5)) 1026.0)
                           pt
                           nil
                  )
              pt3 (interss p3
                           p2
                           (polar pt (+ ang (* pi 0.5)) 1026.0)
                           pt
                           nil
                  )
        )
        (if (and pt1
                 (or (> (pmdist pt1 p1) (+ (pmdist p1 p2) 0.001))
                     (> (pmdist pt1 p2) (+ (pmdist p1 p2) 0.001))
                 )
            )
          (setq pt1 nil)
        )
        (if (and pt2
                 (or (> (pmdist pt2 p1) (+ (pmdist p1 p3) 0.001))
                     (> (pmdist pt2 p3) (+ (pmdist p1 p3) 0.001))
                 )
            )
          (setq pt2 nil)
        )
        (if (and pt3
                 (or (> (pmdist pt3 p3) (+ (pmdist p3 p2) 0.001))
                     (> (pmdist pt3 p2) (+ (pmdist p3 p2) 0.001))
                 )
            )
          (setq pt3 nil)
        )
        (cond
          ((and pt1 pt2 (> (pmdist pt1 pt2) 0.001))
           (command "pline"
                    (lismod pt1 2 (+ z_s z_dd))
                    (lismod pt2 2 (+ z_s z_dd))
                    ""
           )
          )
          ((and pt1 pt3 (> (pmdist pt1 pt3) 0.001))
           (command "pline"
                    (lismod pt1 2 (+ z_s z_dd))
                    (lismod pt3 2 (+ z_s z_dd))
                    ""
           )
          )
          ((and pt3 pt2 (> (pmdist pt3 pt2) 0.001))
           (command "pline"
                    (lismod pt3 2 (+ z_s z_dd))
                    (lismod pt2 2 (+ z_s z_dd))
                    ""
           )
          )
        )
        (setq z_dd (+ (* &var_dgj xs_z) z_dd))
        (if (> (abs z_dd) (abs (- z_s z_e)))
          (setq xh2 nil)
        )
      )                                 ;end of while xh2
    )
  )
)                                       ;end of defun
                                        ;
                                        ;
(defun &sd_ian (p1    p2    p3    z1    z2    z3    /     di    ang1
                ang2  ang   ix    iy    ix1   ix2   iy1   iy2   di
                z_dd  ns1   ns2   xs_z  z_s   z_e   xh2   pt    p01
                p02   pt1   pt2   pt3   dz12  dz13  dx12  dy12  dx13
                dy13  num1  unm2  wb
               )
  (setq ang1 (angle p1 p2)
        di1  (/ (- z2 z1) (pmdist p1 p2))
        ang2 (angle p1 p3)
        di2  (/ (- z3 z1) (pmdist p1 p3))
  )
  (cond
    ((equal (- (car p2) (car p1)) 0.0 0.000001)
     (setq iy (/ (- z2 z1) (- (cadr p2) (cadr p1))))
     (if (equal (- (cadr p3) (cadr p1)) 0.0 0.000001)
       (setq ix (/ (- z3 z1) (- (car p3) (car p1))))
       (setq ix (/ (- z3 z1 (* (- (cadr p3) (cadr p1)) iy))
                   (- (car p3) (car p1))
                )
       )
     )
    )
    ((equal (- (cadr p2) (cadr p1)) 0.0 0.000001)
     (setq ix (/ (- z2 z1) (- (car p2) (car p1))))
     (if (equal (- (car p3) (car p1)) 0.0 0.000001)
       (setq iy (/ (- z3 z1) (- (cadr p3) (cadr p1))))
       (setq iy (/ (- z3 z1 (* (- (car p3) (car p1)) ix))
                   (- (cadr p3) (cadr p1))
                )
       )
     )
    )
    ((equal (- (car p3) (car p1)) 0.0 0.000001)
     (setq iy (/ (- z3 z1) (- (cadr p3) (cadr p1))))
     (if (equal (- (cadr p2) (cadr p1)) 0.0 0.000001)
       (setq ix (/ (- z2 z1) (- (car p2) (car p1))))
       (setq ix (/ (- z2 z1 (* (- (cadr p2) (cadr p1)) iy))
                   (- (car p2) (car p1))
                )
       )
     )
    )
    ((equal (- (cadr p3) (cadr p1)) 0.0 0.000001)
     (setq ix (/ (- z3 z1) (- (car p3) (car p1))))
     (if (equal (- (car p2) (car p1)) 0.0 0.000001)
       (setq iy (/ (- z2 z1) (- (cadr p2) (cadr p1))))
       (setq iy (/ (- z2 z1 (* (- (car p2) (car p1)) ix))
                   (- (cadr p2) (cadr p1))
                )
       )
     )
    )
    (t
     (setq dz12 (- z2 z1)
           dz13 (- z3 z1)
           dx12 (- (car p2) (car p1))
           dx13 (- (car p3) (car p1))
           dy12 (- (cadr p2) (cadr p1))
           dy13 (- (cadr p3) (cadr p1))
     )
     (setq num1 (- dz13 (/ (* dz12 dx13) dx12))
           num2 (- dy13 (/ (* dy12 dx13) dx12))
           iy   (/ num1 num2)
     )
     (setq ix (- (/ dz12 dx12) (/ (* dy12 iy) dx12)))
    )
  )
  (setq ang (angle (list 0.0 0.0 0.0) (list ix iy 0.0))
        di  (sqrt (+ (* ix ix) (* iy iy)))
  )
  (list ix iy ang di)
)                                       ;end of defun
                                        ;
                                        ;
(defun &f_hdgx (/     xh    p1    p2    p3    p4    z1    z2    z3
                z4    di    pt    wb    ix    iy    ang   ent2  xh2
                an1   an2   bg1   bg2   zjz   laynam_dgx
               )
 ;; (setq laynam_dgx (c_pps_chglay "HY_DX_DGXS_LAYER" "laysym" "laynam"))
 ;; (setq laynam_dgqy (c_pps_chglay "HY_DX_FWX_LAYER" "laysym" "laynam"))
  (setq laynam_dgx "PP-DX-DGXS")
  (setq laynam_dgqy "PP-DX-DGQY")
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "plinewid" 0.0)
  (DL_MakeLayer laynam_dgx)
  (setq xh t)
  (while xh
    (prompt "\n按顺时针或逆时针方向依次点取各顶点:")
    (setq p1 (getpoint "\n输入第一点 /<回车退出>:"))
    (if (= p1 nil)
      (setq xh nil)
      (progn
        (initget 1)
        (setq z1 (getreal "\n输入标高:"))
        (initget 1)
        (setq p2 (getpoint p1 "\n输入第二点:"))
        (grdraw p1 p2 -1 1)
        (initget 1)
        (setq z2 (getreal "\n输入标高:"))
        (setq xh2 t)
        (while xh2
          (initget 1)
          (setq p3 (getpoint p2 "\n输入第三点:"))
          (grdraw p2 p3 -1 1)
          (setq an1 (angle p1 p3)
                an2 (angle p1 p2)
          )
          (if (or (< (abs (rem (- an1 an2) pi)) 0.01)
                  (> (abs (rem (- an1 an2) pi)) 3.13)
              )
            (progn
              (print)
              (prompt "\n三点不能在一条线上,重输!")
              (grdraw p2 p3 -1 1)

            )
            (setq xh2 nil)
          )
        )                               ;end of while xh2
        (initget 1)
        (setq z3 (getreal "\n输入标高:"))
        (setq xh2 t)
        (while xh2
          (setq p4 (getpoint p3 "\n输入第四点 /<回车三点等高线>:"))
          (if p4
            (progn
              (grdraw p3 p4 -1 1)
              (grdraw p4 p1 -1 1)
              (setq an1 (angle p1 p2)
                    an2 (angle p1 p4)
                    zjz nil
              )
              (if (or (< (abs (rem (- an1 an2) pi)) 0.01)
                      (> (abs (rem (- an1 an2) pi)) 3.13)
                  )
                (progn
                  (print)
                  (prompt "\n第一,第二,第四点在一条直线上,重输!")
                  (grdraw p1 p2 -1 1)
                  (grdraw p2 p3 -1 1)
                  (grdraw p3 p4 -1 1)
                  (grdraw p4 p1 -1 1)
                )
                (progn
                  (setq an1 (angle p1 p3)
                        an2 (angle p1 p4)
                        zjz nil
                  )
                  (if (or (< (abs (rem (- an1 an2) pi)) 0.01)
                          (> (abs (rem (- an1 an2) pi)) 3.13)
                      )
                    (progn
                      (print)
                      (prompt "\n第一,第三,第四点在一条直线上,重输!")
                      (grdraw p1 p2 -1 1)
                      (grdraw p2 p3 -1 1)
                      (grdraw p3 p4 -1 1)
                      (grdraw p4 p1 -1 1)
                    )
                    (progn
                      (setq an1 (angle p2 p3)
                            an2 (angle p2 p4)
                            zjz nil
                      )
                      (if (or (< (abs (rem (- an1 an2) pi)) 0.01)
                              (> (abs (rem (- an1 an2) pi)) 3.13)
                          )
                        (progn
                          (print)
                          (prompt "\n第二,第三,第四点在一条直线上,重输!"
                          )
                          (grdraw p1 p2 -1 1)
                          (grdraw p2 p3 -1 1)
                          (grdraw p3 p4 -1 1)
                          (grdraw p4 p1 -1 1)
                        )
                        (setq xh2 nil)
                      )
                    )
                  )
                )
              )
              (initget 1)
              (setq z4 (getreal "\n输入标高:"))
            )
            (setq xh2 nil)
          )
        )                               ;end of while xh2
        (if &var_dgj
          (progn
            (initget 6)
            (setq
              zjz (getreal
                    (strcat "\n输入等高距<" (rtos &var_dgj 2 3) ">:")
                  )
            )
            (if zjz
              (setq &var_dgj zjz)
            )
          )
          (progn
            (initget 7)
            (setq &var_dgj (getreal "\n输入等高距:"))
          )
        )
        (HY_SV)
        (if (= p4 nil)
          (progn
            (grdraw p1 p2 -1 1)
            (grdraw p2 p3 -1 1)
            (&sd_dgx p1 p2 p3 z1 z2 z3 &var_dgj)
          )
          (progn
            (grdraw p1 p2 -1 1)
            (grdraw p2 p3 -1 1)
            (grdraw p3 p4 -1 1)
            (grdraw p4 p1 -1 1)
            (setq pt (interss p1 p3 p2 p4 "T"))
            (if pt
              (progn                    ;凸四边形
                (setq bg1 (+ z1
                             (* (/ (pmdist p1 pt) (pmdist p1 p3)) (- z3 z1))
                          )
                      bg2 (+ z2
                             (* (/ (pmdist p2 pt) (pmdist p2 p4)) (- z4 z2))
                          )
                )
                (if (equal bg1 bg2 0.000001)
                  (progn                ;一个平面
                    (setq wb  (&sd_ian p1 p2 p3 z1 z2 z3)
                          ix  (car wb)
                          iy  (cadr wb)
                          ang (caddr wb)
                          di  (cadddr wb)
                    )
                    (setvar "plinewid" 0.0)
                    (DL_MakeLayer laynam_dgqy)
                    (command "pline" p1 p2 p3 p4 "c")
                    (DL_MakeLayer laynam_dgx)
                    (setq ent2 (entlast))
                    (&qy_dgx p1
                             z1
                             ix
                             iy
                             di
                             ang
                             d_dg
                             ent2
                             (list p1 p2 p3 p4)
                    )
                  )
                  (progn                ;两个平面
                    (if (> bg2 bg1)
                      (progn
                        (&sd_dgx p1 p2 p3 z1 z2 z3 &var_dgj)
                        (&sd_dgx p1 p4 p3 z1 z4 z3 &var_dgj)
                      )
                      (progn
                        (&sd_dgx p1 p2 p4 z1 z2 z4 &var_dgj)
                        (&sd_dgx p2 p4 p3 z2 z4 z3 &var_dgj)
                      )
                    )
                  )
                )
              )
              (progn                    ;凹四边形
                (if (interss p1 p4 p2 p3 "T")
                  (prompt "\n输入点顺序不对,重输!")
                  (progn
                    (setq pt (interss p1 p3 p2 p4 nil))
                    (if pt
                      (progn
                        (if (and (< (pmdist pt p1) (pmdist p1 p3))
                                 (< (pmdist pt p3) (pmdist p1 p3))
                            )
                          (progn
                            (&sd_dgx p4 p2 p3 z4 z2 z3 &var_dgj)
                            (&sd_dgx p1 p2 p4 z1 z2 z4 &var_dgj)
                          )
                          (progn
                            (&sd_dgx p1 p2 p3 z1 z2 z3 &var_dgj)
                            (&sd_dgx p1 p4 p3 z1 z4 z3 &var_dgj)
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        )                               ;end of if p4
        (HY_RV)
      )
    )
  )                                     ;end of while xh
  (setvar "clayer" "PP-COM")
  (setvar "elevation" 0.0)
  (setvar "blipmode" 1)
  (setvar "cmdecho" 1)
  (princ)
)                                       ;end of defun
                                        ;
                                        ;
(defun &qy_dgx (pt     bg     ix     iy     di     ang    d_dg   ent2
                ptb    /      ptxb1  ptxb2  p01    p02    p03    ang1
                ang2   ang3   dl1    dl2    dl     ns1    ns2    ppt
                z_s    z_e    xs_z   z_dd   xh2    pt1    pt2    pt3
                laynam_dgx
               )
  ;;(setq laynam_dgx (c_pps_chglay "HY_DX_DGXS_LAYER" "laysym" "laynam"))
  (setq laynam_dgx "PP-DX-DGXS")
  (DL_MakeLayer laynam_dgx)
  (setq ptxb1 nil
        ptxb2 nil
  )
  (foreach p01 ptb
    (if (equal p01 pt 0.001)
      (setq ptxb1 (cons (list pt 0.0) ptxb1)
            ptxb2 (cons (list pt 0.0) ptxb2)
      )
      (progn
        (setq p02  (interss pt
                            (polar pt (+ ang (* pi 0.5)) 1026.0)
                            p01
                            (polar p01 ang 1026.0)
                            nil
                   )
              ang2 (angle pt p02)
              p03  (interss pt
                            (polar pt ang 1026.0)
                            p01
                            (polar p01 (+ ang (* pi 0.5)) 1026.0)
                            nil
                   )
              ang3 (angle pt p03)
        )
        (if
          (or (< (abs (rem (- ang2 (+ ang (* pi 0.5))) (* pi 2.0))) 0.1)
              (> (abs (rem (- ang2 (+ ang (* pi 0.5))) (* pi 2.0))) 6.18)
          )
           (setq ptxb1 (cons (list p01 (pmdist p02 pt)) ptxb1))
           (setq ptxb1 (cons (list p01 (* (pmdist p02 pt) -1.0)) ptxb1))
        )
        (if (or (< (abs (rem (- ang3 ang) (* pi 2.0))) 0.1)
                (> (abs (rem (- ang3 ang) (* pi 2.0))) 6.18)
            )
          (setq ptxb2 (cons (list p01 (pmdist p03 pt)) ptxb2))
          (setq ptxb2 (cons (list p01 (* (pmdist p03 pt) -1.0)) ptxb2))
        )
      )
    )
  )
  (setq ptxb1 (lispx ptxb1)
        ptxb2 (lispx ptxb2)
  )
  (setq p01 (caar ptxb2)
        p02 (car (last ptxb2))
        dl1 (cadar ptxb1)
        dl2 (cadr (last ptxb1))
        dl  (- dl2 dl1)
  )
  (setq z_s (+ bg
               (* ix (- (car p01) (car pt)))
               (* iy (- (cadr p01) (cadr pt)))
            )
        z_e (+ bg
               (* ix (- (car p02) (car pt)))
               (* iy (- (cadr p02) (cadr pt)))
            )
  )
  (setq ns1 (fix (/ z_s &var_dgj))
        ns2 (fix (/ z_e &var_dgj))
  )
  (if (/= ns1 ns2)
    (progn
      (setq ang2 (angle p01 p02)
            z_dd 0.0
      )
      (if (not (or (< (abs (rem (- ang ang2) (* pi 2.0))) 0.1)
                   (> (abs (rem (- ang ang2) (* pi 2.0))) 6.2)
               )
          )
        (setq ang (rem (+ ang (* 2.0 pi)) (* 2.0 pi)))
      )
      (if (> z_e z_s)
        (progn
          (setq xs_z 1.0)
          (if (not (equal z_s (* ns1 &var_dgj) 0.0001))
            (if (< ns1 0)
              (setq z_dd (- (* ns1 &var_dgj) z_s))
              (setq z_dd (- (* (+ ns1 1) &var_dgj) z_s))
            )
          )
        )
        (progn
          (setq xs_z -1.0)
          (if
            (not (equal z_s (* (fix (/ z_s &var_dgj)) &var_dgj) 0.0001))
             (if (> ns1 0)
               (setq z_dd (- (* ns1 &var_dgj) z_s))
               (setq z_dd (- (* (- ns1 1) &var_dgj) z_s))
             )
          )
        )
      )
      (setq xh2 t)
      (while xh2
        (setq ppt (polar p01 ang (abs (/ z_dd di))))
        (setq ptxb1
               (car (HY_LinePLineInt ent2
                              (polar ppt (+ ang (* pi 0.5)) (* 1.2 dl))
                              (polar ppt (- ang (* pi 0.5)) (* 1.2 dl))
                    )
               )
        )
        (if (> (length ptxb1) 1)
          (progn
            (setq pt1   (car ptxb1)
                  ptxb1 (cdr ptxb1)
            )
            (foreach pt2 ptxb1
              (setq pt3
                     (polar pt1 (angle pt1 pt2) (* (pmdist pt1 pt2) 0.5))
              )
              (if (and (HY_IsPtInRgn pt3 ptb) (> (pmdist pt1 pt2) 0.001))
                (progn
                  (command "pline"
                           (lismod pt1 2 (+ z_s z_dd))
                           (lismod pt2 2 (+ z_s z_dd))
                           ""
                  )
                )
              )
              (setq pt1 pt2)
            )
          )
        )
        (setq z_dd (+ (* &var_dgj xs_z) z_dd))
        (if (> (abs z_dd) (abs (- z_s z_e)))
          (setq xh2 nil)
        )
      )                                 ;end of while xh2
      (command "erase" ent2 "")
    )
  )
  (tocom)
)                                       ;end of defun
