明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2396|回复: 10

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

[复制链接]
发表于 2014-8-9 12:01:43 | 显示全部楼层 |阅读模式
5明经币
本帖最后由 王与韩1 于 2014-8-9 19:11 编辑

这是论坛的zml84大神写的一个程序,作用是将数字分成和相近的三组并列出组别,如下图
希望大家能帮助改动一下,1.待分组的数字是“6kW"这种,后面加了个”kW"后缀。2.实现输入“10kW"("10KW“只是举例),则只有小于10的才进入分组,10及以上的都不分组。希望各位大神不吝赐教
  1. (defun C:tt ()
  2.   (setq *n* 3) ;_容器数量

  3.   ;; 0、选择
  4.   (if (and (princ "\n请选择数值文本对象...")
  5.      (setq SS (ssget '((0 . "*TEXT"))))
  6.       )
  7.     (progn
  8.       ;; 1、形成列表
  9.       (setq LST  '()
  10.       I  0
  11.       )
  12.       (repeat (sslength SS)
  13.   (setq en   (ssname SS I)
  14.         ent  (entget en)
  15.         real (read (cdr (assoc 1 ent)))
  16.   )
  17.   (setq LST (cons (list real en) LST))
  18.   (setq I (1+ I))
  19.       )
  20.       (setq lst (reverse LST))
  21.       ;; 2、排序
  22.       (setq lst  (vl-sort lst
  23.        '(lambda (e1 e2)
  24.           (>= (car e1) (car e2))
  25.         )
  26.     )
  27.       )
  28.       ;;(print lst)
  29.       ;; 3、创建容器
  30.       (setq *lst* '()
  31.       i 65
  32.       )
  33.       (repeat *n*
  34.   (setq *lst* (cons (list (list 0 i)) *lst*)
  35.         i      (1+ i)
  36.   )
  37.       )
  38.       (setq *lst* (reverse *lst*))
  39.       ;; 4、逐个分配
  40.       (foreach N lst
  41.   (setq *lst* (tt-02 *lst* N))
  42.       )
  43.       (setq *lst* (mapcar 'reverse *lst*))
  44.       ;;(print *lst*)
  45.       ;; 5、让用户指定相位名称
  46.       (if ZL-INPUTBOX
  47.   (setq *lst* (tt-05-01 *lst*))
  48.   (setq *lst* (tt-05-02 *lst*))
  49.       )
  50.       ;; 6、写文字
  51.       (foreach n *lst*
  52.   (setq str ( nth 2 (car n))
  53.         n    (cdr n)
  54.   )
  55.   (foreach m n
  56.     (command "_.copy" (cadr m) "" '(0 0) '(0 2500))
  57.     (setq  en  (entlast)
  58.     ent (entget en)
  59.     ent (subst (cons 1 str) (assoc 1 ent) ent)
  60.     ent (subst (cons 62 6) (assoc 62 ent) ent)
  61.     )
  62.     (entmod ent)
  63.   )
  64.       )
  65.       ;; 7、显示结果
  66.       (setq lst_str '())
  67.       (foreach n *lst*
  68.   (setq str ( nth 2(car n))
  69.         lst (mapcar 'car (cdr n))
  70.         sum (apply '+ lst)
  71.   )
  72.   (setq lst_str (cons (strcat "\n\n相位 = "
  73.             str
  74.             "\t\tsum = "
  75.             (rtos sum 2 2)
  76.             "\t\t成员 = "
  77.             (vl-princ-to-string lst)
  78.           )
  79.           lst_str
  80.           )
  81.   )
  82.       )
  83.       (setq lst_str
  84.        (append '("\n===========================================")
  85.          (reverse lst_str)
  86.          '("\n===========================================")
  87.        )
  88.       )
  89.       (alert (princ (apply 'strcat lst_str)))
  90.       ;;
  91.     )
  92.   )
  93.   (princ)
  94. )

  95. ;;;=================================================================*
  96. ;;;功能:根据差值决定分配给谁,返回结果
  97. ;;;      将数值  分配给  总和最小的表。
  98. (defun tt-02 (*lst* N / i tmp)
  99.   (setq  i   (IsMin *lst*)
  100.   tmp (nth i *lst*)
  101.   )
  102.   (setq *lst* (subst (cons n tmp) tmp *lst*))
  103.   ;;返回
  104.   *lst*
  105. )
  106. ;;;

  107. ;;;=================================================================*
  108. ;;参数:lst ----- '( ( (r en) (r en)..)
  109. ;;                   ( (r en) (r en)..)
  110. ;;                   ( (r en) (r en)..)
  111. ;;                   ...
  112. ;;                 )
  113. ;;返回:最小值是第几个
  114. (defun IsMin (lst / lst_tmp)
  115.   (setq  lst_tmp  (mapcar  '(lambda (x)
  116.          (apply '+ (mapcar 'car x))
  117.        )
  118.       lst
  119.     )
  120.   lst_tmp  (vl-sort-i lst_tmp '<=)
  121.   )
  122.   ;;返回
  123.   (car lst_tmp)
  124. )
  125. ;;;=================================================================*
  126. ;;;=================================================================*
  127. ;;;功能:询问用户,附加相位名称(方式一:对话框)
  128. ;;(defun C:TT () (tt-05-01 *lst*))
  129. (defun tt-05-01 (lst / lst_tmp)
  130.   ;; 修改数据格式
  131.   (setq  lst_tmp  (mapcar  '(lambda (e)
  132.          (cons (list 0 (apply '+ (mapcar 'car e)))
  133.          (cdr e)
  134.          )
  135.        )
  136.       lst
  137.     )
  138.   )
  139.   ;; 排序
  140.   (setq
  141.     lst_tmp
  142.      (vl-sort lst_tmp
  143.         '(lambda (e1 e2)
  144.      (>= (cadar e1)
  145.          (cadar e2)
  146.      )
  147.          )
  148.      )
  149.   )
  150.   ;; 对话框获取输入
  151.   (if (setq lst_str
  152.        (ZL-INPUTBOX
  153.          "相位指定"
  154.          (list
  155.      (list "popup_list"
  156.            (strcat "  " (rtos (cadar (nth 0 lst_tmp)) 2 2) "   伯:")
  157.            '("L1" "L2" "L3")
  158.            "20"
  159.      )
  160.      (list "popup_list"
  161.            (strcat "  " (rtos (cadar (nth 1 lst_tmp)) 2 2) "   仲:")
  162.            '("L2" "L3" "L1")
  163.            "20"
  164.      )
  165.      (list "popup_list"
  166.            (strcat "  " (rtos (cadar (nth 2 lst_tmp)) 2 2) "   叔:")
  167.            '("L3" "L1" "L2")
  168.            "20"
  169.      )
  170.      '("spacer_1")
  171.      '("*text" "")
  172.          )
  173.        )
  174.       )
  175.     ;;返回
  176.     (mapcar '(lambda (tmp str)
  177.          (cons (list 0 (cadar tmp) str) (cdr tmp))
  178.        )
  179.       lst_tmp
  180.       lst_str
  181.     )
  182.     ()
  183.   )
  184. )
  185. ;;;=================================================================*
  186. ;;;功能:询问用户,附加相位名称(方式二:命令行)
  187. ;;(defun C:TT () (tt-05-02 *lst*))
  188. (defun tt-05-02  (lst / lst_tmp lst_str)
  189.   ;; 修改数据格式
  190.   (setq  lst_tmp  (mapcar  '(lambda (e)
  191.          (cons (list 0 (apply '+ (mapcar 'car e)))
  192.          (cdr e)
  193.          )
  194.        )
  195.       lst
  196.     )
  197.   )
  198.     ;; 获取输入
  199.   (or (and
  200.   (princ "\n相位指定(例如:"ABC"/"BCA"...]<"ABC">: ")
  201.   (setq lst_str (getstring))
  202.   (setq lst_str (vl-string->list (strcase lst_str)))
  203.   (= (length lst_str) *n*)
  204.   (setq lst_str (mapcar 'chr lst_str))
  205.       )
  206.       (setq lst_str '("L1" "L2" "L3"))
  207.   )
  208.   ;; 返回
  209.   (mapcar '(lambda (tmp str)
  210.          (cons (list 0 (cadar tmp) str) (cdr tmp))
  211.        )
  212.       lst_tmp
  213.       lst_str
  214.     )
  215. )
  216. ;;;=================================================================*
  217. (alert "命令名称:"TT"")
  218. (PRINC)

附件: 您需要 登录 才可以下载或查看,没有账号?注册

点评

上dwg图!  发表于 2014-8-9 13:11
发表于 2014-8-9 12:16:16 | 显示全部楼层
还是自学一下吧。。这个应该不难啊
回复

使用道具 举报

 楼主| 发表于 2014-8-9 12:26:21 | 显示全部楼层
本帖最后由 王与韩1 于 2014-8-9 13:50 编辑
ysq101 发表于 2014-8-9 12:16
还是自学一下吧。。这个应该不难啊

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

使用道具 举报

 楼主| 发表于 2014-8-9 12:33:44 | 显示全部楼层
怎么去改成支持天正文字呢?"text"改为”*text"后,一用命令就直接弹出cad了
回复

使用道具 举报

发表于 2014-8-9 13:01:09 | 显示全部楼层
就算会写! 写个程序也得小半天! 除非是院长那个级别的,可以信手拈来!

不仅是你忙, 大家也很忙啊!
回复

使用道具 举报

 楼主| 发表于 2014-8-9 13:28:15 | 显示全部楼层
所以说菜鸟求助嘛,谢谢各位
回复

使用道具 举报

发表于 2014-8-9 18:24:27 | 显示全部楼层
0基础学arx吧
回复

使用道具 举报

 楼主| 发表于 2014-8-9 18:28:40 | 显示全部楼层
luowy 发表于 2014-8-9 18:24
0基础学arx吧

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

使用道具 举报

 楼主| 发表于 2014-8-10 00:27:32 | 显示全部楼层
冒个泡,请各位前辈赐教
回复

使用道具 举报

发表于 2020-1-10 13:27:49 | 显示全部楼层
没啥用啊 三相平衡就是个伪命题。这种小负荷真的没必要考虑去配平。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-12-23 16:08 , Processed in 0.207932 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表