请各位前辈改进程序

wyuh12 · 发表于 2014-8-10 00:34:21

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

以下是我收集的一个程序，作用是将数字分成和相近的三组。现在希望能改动一下：1.1.待分组的不全是数字，是“6kW"这种，后面加了个”kW"后缀。2.实现输入“10kW"("10KW“只是举例），则只有小于10的才进入分组，10及以上的都不分组。先谢过各位，

(defun C:tt ()
(setq *n* 3) ;_容器数量
;; 0、选择
(if (and (princ "\n请选择数值文本对象...")
(setq SS (ssget '((0 . "*TEXT"))))
)
(progn
;; 1、形成列表
(setq LST '()
I 0
)
(repeat (sslength SS)
(setq en (ssname SS I)
ent (entget en)
real (read (cdr (assoc 1 ent)))
)
(setq LST (cons (list real en) LST))
(setq I (1+ I))
)
(setq lst (reverse LST))
;; 2、排序
(setq lst (vl-sort lst
'(lambda (e1 e2)
(>= (car e1) (car e2))
)
)
)
;;(print lst)
;; 3、创建容器
(setq *lst* '()
i 65
)
(repeat *n*
(setq *lst* (cons (list (list 0 i)) *lst*)
i (1+ i)
)
)
(setq *lst* (reverse *lst*))
;; 4、逐个分配
(foreach N lst
(setq *lst* (tt-02 *lst* N))
)
(setq *lst* (mapcar 'reverse *lst*))
;;(print *lst*)
;; 5、让用户指定相位名称
(if ZL-INPUTBOX
(setq *lst* (tt-05-01 *lst*))
(setq *lst* (tt-05-02 *lst*))
)
;; 6、写文字
(foreach n *lst*
(setq str ( nth 2 (car n))
n (cdr n)
)
(foreach m n
(command "_.copy" (cadr m) "" '(0 0) '(0 2500))
(setq en (entlast)
ent (entget en)
ent (subst (cons 1 str) (assoc 1 ent) ent)
ent (subst (cons 62 6) (assoc 62 ent) ent)
)
(entmod ent)
)
)
;; 7、显示结果
(setq lst_str '())
(foreach n *lst*
(setq str ( nth 2(car n))
lst (mapcar 'car (cdr n))
sum (apply '+ lst)
)
(setq lst_str (cons (strcat "\n\n相位 = "
str
"\t\tsum = "
(rtos sum 2 2)
"\t\t成员 = "
(vl-princ-to-string lst)
)
lst_str
)
)
)
(setq lst_str
(append '("\n===========================================")
(reverse lst_str)
'("\n===========================================")
)
)
(alert (princ (apply 'strcat lst_str)))
;;
)
)
(princ)
)
;;;=================================================================*
;;;功能：根据差值决定分配给谁，返回结果
;;; 将数值分配给总和最小的表。
(defun tt-02 (*lst* N / i tmp)
(setq i (IsMin *lst*)
tmp (nth i *lst*)
)
(setq *lst* (subst (cons n tmp) tmp *lst*))
;;返回
*lst*
)
;;;
;;;=================================================================*
;;参数：lst ----- '( ( (r en) (r en)..)
;; ( (r en) (r en)..)
;; ( (r en) (r en)..)
;; ...
;; )
;;返回：最小值是第几个
(defun IsMin (lst / lst_tmp)
(setq lst_tmp (mapcar '(lambda (x)
(apply '+ (mapcar 'car x))
)
lst
)
lst_tmp (vl-sort-i lst_tmp '<=)
)
;;返回
(car lst_tmp)
)
;;;=================================================================*
;;;=================================================================*
;;;功能：询问用户，附加相位名称（方式一：对话框）
;;(defun C:TT () (tt-05-01 *lst*))
(defun tt-05-01 (lst / lst_tmp)
;; 修改数据格式
(setq lst_tmp (mapcar '(lambda (e)
(cons (list 0 (apply '+ (mapcar 'car e)))
(cdr e)
)
)
lst
)
)
;; 排序
(setq
lst_tmp
(vl-sort lst_tmp
'(lambda (e1 e2)
(>= (cadar e1)
(cadar e2)
)
)
)
)
;; 对话框获取输入
(if (setq lst_str
(ZL-INPUTBOX
"相位指定"
(list
(list "popup_list"
(strcat " " (rtos (cadar (nth 0 lst_tmp)) 2 2) " 伯：")
'("L1" "L2" "L3")
"20"
)
(list "popup_list"
(strcat " " (rtos (cadar (nth 1 lst_tmp)) 2 2) " 仲：")
'("L2" "L3" "L1")
"20"
)
(list "popup_list"
(strcat " " (rtos (cadar (nth 2 lst_tmp)) 2 2) " 叔：")
'("L3" "L1" "L2")
"20"
)
'("spacer_1")
'("*text" "")
)
)
)
;;返回
(mapcar '(lambda (tmp str)
(cons (list 0 (cadar tmp) str) (cdr tmp))
)
lst_tmp
lst_str
)
()
)
)
;;;=================================================================*
;;;功能：询问用户，附加相位名称（方式二：命令行）
;;(defun C:TT () (tt-05-02 *lst*))
(defun tt-05-02 (lst / lst_tmp lst_str)
;; 修改数据格式
(setq lst_tmp (mapcar '(lambda (e)
(cons (list 0 (apply '+ (mapcar 'car e)))
(cdr e)
)
)
lst
)
)
;; 获取输入
(or (and
(princ "\n相位指定(例如：\"ABC\"/\"BCA\"...]<\"ABC\">: ")
(setq lst_str (getstring))
(setq lst_str (vl-string->list (strcase lst_str)))
(= (length lst_str) *n*)
(setq lst_str (mapcar 'chr lst_str))
)
(setq lst_str '("L1" "L2" "L3"))
)
;; 返回
(mapcar '(lambda (tmp str)
(cons (list 0 (cadar tmp) str) (cdr tmp))
)
lst_tmp
lst_str
)
)
;;;=================================================================*
(alert "命令名称：\"TT\"")
(PRINC)

HLCAD · 发表于 2014-8-10 12:23:34

(setq Lst '("100" "123KW" 1 2 3 "3kw" 5 "5kw" 10 "10kw" 13 "13kw" 15 "15kw" 20 "20kw"))
(setq kw-max 10.0) ;;;设置<=10阀值
(setq min-Lst '())
(setq max-Lst '())
(mapcar '(lambda(x)
(cond
((numberp x)
(if (<= x kw-max)
(setq min-Lst (cons x min-Lst))
(setq max-Lst (cons x max-Lst))
))
((= (type x) 'STR)
(if (<= (atof x) kw-max)
(setq min-Lst (cons x min-Lst))
(setq max-Lst (cons x max-Lst))
))
(t (alert "存在未知数据，程序有错"))
)) Lst)
(setq min-Lst (reverse min-Lst))
(setq max-Lst (reverse max-Lst))
;;; 现分大组，运行后便知。

wyuh12 · 发表于 2014-8-10 18:20:06

HLCAD 发表于 2014-8-10 12:23

谢谢这位前辈，新手求问这个加到哪里啊...

HLCAD · 发表于 2014-8-10 22:56:14

wyuh12 发表于 2014-8-10 18:20
谢谢这位前辈，新手求问这个加到哪里啊...

没有看你的程序，只是将表分开为：一个是10或“10KW”及其以下的组成一个表，其余的组成另一个表。程序是个示范，只是想教你读懂程序后自己编入程序中。只能帮你到这了。

wyuh12 · 发表于 2014-8-10 23:09:50

HLCAD 发表于 2014-8-10 22:56
没有看你的程序，只是将表分开为：一个是10或“10KW”及其以下的组成一个表，其余的组成另一个表。程序是 ...

好的，谢谢了，我要加油

账号		自动登录	找回密码
密码			立即注册

[求助] 请各位前辈改进程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评

浏览过的版块