社区 › AutoLISP/Visual LISP 编程技术 › 全部家当请大师帮忙修改程序

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

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

本帖最后由 王与韩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'()
      I0
      )
      (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))
    (setqen(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)
(setqi   (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)
(setqlst_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)
;; 修改数据格式
(setqlst_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)
;; 修改数据格式
(setqlst_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:16

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

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

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

ysq101 发表于 2014-8-9 12:16 static/image/common/back.gif
还是自学一下吧。。这个应该不难啊
才入论坛没多久，只会用command和简单的lsp，这个对我有点复杂，努力学习中...

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

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

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

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

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

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

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

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

0基础学arx吧

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

luowy 发表于 2014-8-9 18:24 static/image/common/back.gif
0基础学arx吧

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

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

冒个泡，请各位前辈赐教

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

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

查看完整版本: 全部家当请大师帮忙修改程序