有人需要的QH源码

lsmgys

你们需要的QH源码来了
(defun CH (/ *GETATTRIBUTES* *TOTAL-TEXT* A B C F G TMP SS)
  (defun *GETATTRIBUTES* (ENT / LST R F)
    (if (ENTNEXT ENT)
      (progn
        (while (= (CDR (ASSOC 0 (setq LST (ENTGET (setq ENT (ENTNEXT ENT)))))) "ATTRIB")
          (setq R (CONS (MAPCAR 'CDR (MAPCAR 'ASSOC '(-1 2 1) (LIST LST LST LST))) R))
        )
        (setq E (MAPCAR '(LAMBDA (X) (CDR X)) R))
        (if (setq F (ASSOC "LENGTH" E))
          (if (NUMBERP (setq F (READ (CADR F)))) (setq TMP F) (setq TMP nil))
          (setq TMP nil)
        )
      )
    )
    TMP
  )
  (defun *TOTAL-TEXT* (SS)
    (if (setq TMP (ASSOC 1 (ENTGET SS)))
      (if (NUMBERP (setq TMP (READ (CDR TMP)))) (setq TMP TMP) (setq TMP nil))
      (setq TMP nil)
    )
    TMP
  )
  (setq C -1)
  (setq B nil)
  (setq SS (SSGET))
  (repeat (SSLENGTH SS)
    (setq A (SSNAME SS (setq C (1+ C))))
    (cond
      ((NUMBERP (setq F (*TOTAL-TEXT* A))) (setq B (CONS F B)))
      ((NUMBERP (setq G (*GETATTRIBUTES* A))) (setq B (CONS G B)))
      (T (setq B (CONS 0 B)))
    )
  )
  (setq B (APPLY '+ B))
      (ALERT (princ(STRCAT "合计：" (RTOS B) " 米")))

(princ)       
)