全部家当请大师帮忙修改程序

王与韩1 · 发表于 2014-8-9 12:01

本帖最后由王与韩1 于 2014-8-9 19:11 编辑

这是论坛的zml84大神写的一个程序，作用是将数字分成和相近的三组并列出组别，如下图
希望大家能帮助改动一下，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)

(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)

ysq101 · 发表于 2014-8-9 12:16

还是自学一下吧。。这个应该不难啊

王与韩1 · 发表于 2014-8-9 12:26

本帖最后由王与韩1 于 2014-8-9 13:50 编辑

ysq101 发表于 2014-8-9 12:16
还是自学一下吧。。这个应该不难啊

才入论坛没多久，只会用command和简单的lsp，这个对我有点复杂，努力学习中...

王与韩1 · 发表于 2014-8-9 12:33

怎么去改成支持天正文字呢？"text"改为”*text"后，一用命令就直接弹出cad了

wowan1314 · 发表于 2014-8-9 13:01

就算会写！写个程序也得小半天！除非是院长那个级别的，可以信手拈来！

不仅是你忙，大家也很忙啊！

王与韩1 · 发表于 2014-8-9 13:28

所以说菜鸟求助嘛，谢谢各位

luowy · 发表于 2014-8-9 18:24

0基础学arx吧

王与韩1 · 发表于 2014-8-9 18:28

luowy 发表于 2014-8-9 18:24
0基础学arx吧

看了两周Autolisp的.感觉还行,arx我都没概念啊..

王与韩1 · 发表于 2014-8-10 00:27

冒个泡，请各位前辈赐教

3625095 · 发表于 2020-1-10 13:27

没啥用啊三相平衡就是个伪命题。这种小负荷真的没必要考虑去配平。

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

[已解答] 全部家当请大师帮忙修改程序

点评

相关帖子