通信人家园

标题: 有人需要的QH源码 [查看完整版帖子] [打印本页]

时间: 2021-5-18 23:44

作者: lsmgys 标题: 有人需要的QH源码

你们需要的QH源码来了
(defun C

H (/ *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)
)

通信人家园 (https://www.txrjy.com/)