[讨论]：组合三角面的等高线和坡度判定

ago9999

;;;;希望大家帮做个水流方向和边界排水对应面积的程序
(defun c:pd (/ podu0 podu_min 3df_ss n 3df_n 3df_en pt_a pt_a0 pt_b pt_b0 pt_c pt_c0 ;pt_d pt_e pt_f pt_i pt0
             ldjl_end sjmj_end s s0 d d0 s_0_5 s_5_10 s_10_15 s_15 s_0_5 s_5_10 s_10_15 s0_15)
  ;(princ "请输入坡度控制值%(默认17.6%)")
  ;(setq podu0 (getreal)
  ;(if (= podu0 nil) (setq podu0 0.176))
  ;(princ podu0)(princ "\n")
  (princ "请选择膜体")
  (setq 3df_ss (ssget (list (cons 0' "3DFACE"))))
  (setq podu_min 100)
  (sta)
  (setq s_0_5 0 s_5_10 0 s_10_15 0 s_15 0
        s0_0_5 0 s0_5_10 0 s0_10_15 0 s0_15 0)
  (setq n 0)                                     ;(princ "n=")(princ n)
  (while (< n (sslength 3df_ss)); 定义循环                           
    (setq 3df_n (ssname 3df_ss n))
    (setq 3df_en (entget 3df_n))
    (setq pt_a  (cdr (assoc '10 3df_en)))       ;(princ "pt_a=")(princ pt_a)
    (setq pt_a0 (list (nth 0 pt_a) (nth 1 pt_a) 0))
    (setq pt_b  (cdr (assoc '11 3df_en)))
    (setq pt_b0 (list (nth 0 pt_b) (nth 1 pt_b) 0))
    (setq pt_c  (cdr (assoc '12 3df_en)))
    (setq pt_c0 (list (nth 0 pt_c) (nth 1 pt_c) 0))
    (ldjl pt_a pt_b)
    (setq l1 ldjl_end)         ;(princ "l1=")(princ l1)
    (ldjl pt_b pt_c)
    (setq l2 ldjl_end)
    (ldjl pt_c pt_a)
    (setq l3 ldjl_end)
    (sjmj l1 l2 l3)
    (setq s sjmj_end)
    (setq d (sqrt sjmj_end))
    (ldjl pt_a0 pt_b0)
    (setq l10 ldjl_end)
    (ldjl pt_b0 pt_c0)
    (setq l20 ldjl_end)
    (ldjl pt_c0 pt_a0)
    (setq l30 ldjl_end)
    (sjmj l10 l20 l30)
    (setq s0 sjmj_end)
    (setq d0 (sqrt sjmj_end))
    (setq podu (/ (sqrt (- (* d d) (* d0 d0))) d0))
    ;(setq pt_d (inters pt_a pt_c pt_a0 pt_c0 NIL))
    ;(setq pt_e (inters pt_b pt_c pt_b0 pt_c0 NIL)) ;(princ "pt_d=")(princ pt_d)(princ "pt_e=")(princ pt_e)
    ;(setq pt_f (polar pt_c0 (+ (* 0.5 pi) (angle pt_d pt_e)) 1000))
    ;(setq pt_i (inters pt_d pt_e pt_c0 pt_f NIL))  ;(princ "pt_f=")(princ pt_f)(princ "pt_i=")(princ pt_i)
    ;(princ "pt_i=")(princ pt_i)(princ "pt_c0=")(princ pt_c0)
    ;(setq podu (/ (nth 2 pt_c) (distance (list (nth 0 pt_i) (nth 1 pt_i)) (list (nth 0 pt_c0) (nth 1 pt_c0)))))
    ;(cond ((< podu 0) (setq podu (* -1 podu))))
    (setq podu (* 100 podu))
    ;(princ "/")(princ podu)
    (setq pt0 (list (* 0.3 (+ (nth 0 pt_a) (nth 0 pt_b) (nth 0 pt_c)))
                             (* 0.3 (+ (nth 1 pt_a) (nth 1 pt_b) (nth 1 pt_c)))
                             (* 0.3 (+ (nth 2 pt_a) (nth 2 pt_b) (nth 2 pt_c)))))
   
    (cond
      ((>= podu 15)
       (command "chprop" 3df_n "" "c" "7" "")
       (setq s_15 (+ s_15 s))
       (setq s0_15 (+ s0_15 s0))
       ;(command "text" pt0 "" (princ podu) "" 14 "")
       )
      ((and (>= podu 10) (< podu 15))
       (command "chprop" 3df_n "" "c" "5" "")
       (setq s_10_15 (+ s_10_15 s))
       (setq s0_10_15 (+ s0_10_15 s0))
       ;(command "text" pt0 "" "" 14 "")
       )
      ((and (>= podu 5) (< podu 10))
       (setq s_5_10 (+ s_5_10 s))
       (setq s0_5_10 (+ s0_5_10 s0))
       (command "chprop" 3df_n "" "c" "2" "")
       ;(command "text" pt0 "" "" 5 "")
       )
      ((< podu 5)
       (setq s_0_5 (+ s_0_5 s))
       (setq s0_0_5 (+ s0_0_5 s0))
       (command "chprop" 3df_n "" "c" "1" "")
       ;(command "text" pt0 "" "" 0 "")
       ))
    (cond ((< podu podu_min) (setq podu_min podu)))
    (setq n (1+ n))
    )
  (princ "\n膜体总面积为：")
  (princ (+ (* 0.000001 s_0_5) (* 0.000001 s_5_10) (* 0.000001 s_10_15)(* 0.000001 s_15)))
  (princ "平方米;膜体总投影面积为：")
  (princ (+ (* 0.000001 s0_0_5) (* 0.000001 s0_5_10) (* 0.000001 s0_10_15)(* 0.000001 s0_15)))
  (princ "平方米;\n最小坡度为")(princ podu_min)(princ "%")
  (princ ";\n坡度0~5%的红色面积为：")(princ (* 0.000001 s_0_5))
  (princ "平方米;其投影面积为：")(princ (* 0.000001 s0_0_5))
  (princ "平方米;\n坡度5~10%的黄色面积为：")(princ (* 0.000001 s_5_10))
  (princ "平方米;其投影面积为：")(princ (* 0.000001 s0_5_10))
  (princ "平方米;\n坡度10~15%的蓝色面积为：")(princ (* 0.000001 s_10_15))
  (princ "平方米;其投影面积为：")(princ (* 0.000001 s0_10_15))
  (princ "平方米;\n坡度15%以上的白色面积为：")(princ (* 0.000001 s_15))
  (princ "平方米;其投影面积为：")(princ (* 0.000001 s0_15))
  (princ "平方米;")
  (end)
  (princ)
  )
(defun ldjl (ldjl_pt1 ldjl_pt2 /)
  (setq ldjl_end (sqrt (+ (* (- (nth 0 ldjl_pt1) (nth 0 ldjl_pt2)) (- (nth 0 ldjl_pt1) (nth 0 ldjl_pt2)))
                (* (- (nth 1 ldjl_pt1) (nth 1 ldjl_pt2)) (- (nth 1 ldjl_pt1) (nth 1 ldjl_pt2)))
                (* (- (nth 2 ldjl_pt1) (nth 2 ldjl_pt2)) (- (nth 2 ldjl_pt1) (nth 2 ldjl_pt2))))))
  ;(princ "ldjl_end=")(princ ldjl_end)
  )
(defun sjmj (sjmj-l1 sjmj-l2 sjmj-l3 / s)
  (setq s (* 0.5 (+ sjmj-l1 sjmj-l2 sjmj-l3)))
  (setq sjmj_end (sqrt (* s (- s sjmj-l1) (- s sjmj-l2) (- s sjmj-l3))))
  ;(princ "sjmj_end=")(princ sjmj_end)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dgx (/ dgx_h 3df_ss m n 3df_ss 3df_n 3df_en ma mb mc h ptab_x ptab_y ptac_x ptac_y ptbc_x ptbc_y
              pt0_z pta ptb ptc pta_x pta_y pta_z ptb_x ptb_y ptb_z ptc_x ptc_y ptc_z pl_ss cec)
  (princ "\n请输入等高线相邻两线高差")
  (setq dgx_h (getint))
  ;(princ "\n请选择等高线基点")
  ;(setq pt0 (getpoint))
  (princ "\n请选择分析膜体")
  (setq 3df_ss (ssget (list (cons 0' "3DFACE"))))
  (sta)
  (command "layer" "n" "等高线" "s" "等高线" "")
  ;(setq pt0_z (nth 2 pt0))
  (setq n 0)
  ;(setq pl_ss (ssget "x" (list (cons 8' "等高线"))))
  (while (< n (sslength 3df_ss))
    (setq 3df_n (ssname 3df_ss n))
    (setq 3df_en (entget 3df_n))
    (setq pta  (cdr (assoc '10 3df_en)))      
    (setq ptb  (cdr (assoc '11 3df_en)))
    (setq ptc  (cdr (assoc '12 3df_en)))
    ;
    (setq pta_x (nth 0 pta)
          pta_y (nth 1 pta)
          pta_z (nth 2 pta))
    (setq ptb_x (nth 0 ptb)
          ptb_y (nth 1 ptb)
          ptb_z (nth 2 ptb))
    (setq ptc_x (nth 0 ptc)
          ptc_y (nth 1 ptc)
          ptc_z (nth 2 ptc))
   
    (setq ma (fix (/ pta_z dgx_h))
          mb (fix (/ ptb_z dgx_h))
          mc (fix (/ ptc_z dgx_h)))
               ;(princ "ma=")(princ ma)(princ "mb=")(princ mb)(princ "mc=")(princ mc)
     ;;a
    (setq m 0)
    (while (> (* (- ma mb m) (- ma mc m)) 0 )
      (if (> ma mb)
        (setq h (* dgx_h (- ma m))
              m (1+ m))
        (setq h (* dgx_h (+ ma (+ (* -1 m) 1 )))
              m (- m 1))
        )
      (setq ptab_y (+ pta_y (/ (* (- h pta_z) (- ptb_y pta_y)) (- ptb_z pta_z))))
      (setq ptab_x (+ pta_x (/ (* (- h pta_z) (- ptb_x pta_x)) (- ptb_z pta_z))))
      (setq ptac_y (+ pta_y (/ (* (- h pta_z) (- ptc_y pta_y)) (- ptc_z pta_z))))
      (setq ptac_x (+ pta_x (/ (* (- h pta_z) (- ptc_x pta_x)) (- ptc_z pta_z))))
      (setq pt1 (list ptab_x ptab_y h))
      (setq pt2 (list ptac_x ptac_y h))
      (setq cec (abs(- (/ h dgx_h) (* 10 (fix( / (/ h dgx_h) 10))))));(princ cec)
      (cond ((= cec 0)(setq cec 11))
            ((= cec 7)(setq cec 71))
            ((= cec 8)(setq cec 131))
            ((= cec 9)(setq cec 191)))
      (command "CECOLOR" cec)
      (command "line" pt1 pt2 "")
      ;(setq pl_ss (ssadd (ssget "l") pl_ss))
          )  ;(princ "m=")(princ m)
     ;;b
        (setq m 0)
    (while (> (* (- mb ma m) (- mb mc m)) 0 )
      (if (> mb ma)
        (setq h (* dgx_h (- mb m))
              m (1+ m))
        (setq h (* dgx_h (+ mb (+ (* -1 m) 1 )))
              m (- m 1))
        )
      (setq ptab_y (+ pta_y (/ (* (- h pta_z) (- ptb_y pta_y)) (- ptb_z pta_z))))
      (setq ptab_x (+ pta_x (/ (* (- h pta_z) (- ptb_x pta_x)) (- ptb_z pta_z))))
      (setq ptbc_y (+ ptb_y (/ (* (- h ptb_z) (- ptc_y ptb_y)) (- ptc_z ptb_z))))
      (setq ptbc_x (+ ptb_x (/ (* (- h ptb_z) (- ptc_x ptb_x)) (- ptc_z ptb_z))))
      (setq pt1 (list ptab_x ptab_y h))
      (setq pt2 (list ptbc_x ptbc_y h))
      (setq cec (abs(- (/ h dgx_h) (* 10 (fix( / (/ h dgx_h) 10))))))
      (cond ((= cec 0)(setq cec 11))
            ((= cec 7)(setq cec 71))
            ((= cec 8)(setq cec 131))
            ((= cec 9)(setq cec 191)))
      (command "CECOLOR" cec)
      (command "line" pt1 pt2 "")
      ;(setq pl_ss (ssadd (ssget "l") pl_ss))
          );(princ "m=")(princ m)
    ;;c
        (setq m 0)
    (while (> (* (- mc mb m) (- mc ma m)) 0 )
      (if (> mc mb)
        (setq h (* dgx_h (- mc m))
              m (1+ m))
        (setq h (* dgx_h (+ mc (+ (* -1 m) 1 )))
              m (- m 1))
        )
      (setq ptbc_y (+ ptc_y (/ (* (- h ptc_z) (- ptb_y ptc_y)) (- ptb_z ptc_z))))
      (setq ptbc_x (+ ptc_x (/ (* (- h ptc_z) (- ptb_x ptc_x)) (- ptb_z ptc_z))))
      (setq ptac_y (+ pta_y (/ (* (- h pta_z) (- ptc_y pta_y)) (- ptc_z pta_z))))
      (setq ptac_x (+ pta_x (/ (* (- h pta_z) (- ptc_x pta_x)) (- ptc_z pta_z))))
      (setq pt1 (list ptbc_x ptbc_y h))
      (setq pt2 (list ptac_x ptac_y h))
      (setq cec (abs(- (/ h dgx_h) (* 10 (fix( / (/ h dgx_h) 10))))))
      (cond ((= cec 0)(setq cec 11))
            ((= cec 7)(setq cec 71))
            ((= cec 8)(setq cec 131))
            ((= cec 9)(setq cec 191)))
      (command "CECOLOR" cec)
      (command "line" pt1 pt2 "")
      ;(setq pl_ss (ssadd (ssget "l") pl_ss))
          );(princ "m=")(princ m)
    (setq n (1+ n)))(princ "n=")(princ n)
  (command "pedit" "m" pl_ss "" "")
  (command "layer" "s" "0" "")
  (end)
  (princ)
  )