明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1015|回复: 5

[提问] 线长统计计算价格

[复制链接]
发表于 2019-1-17 11:30:26 | 显示全部楼层 |阅读模式
这是选线计算加工价格,其中红线有错误,水平有限没找到原因,望改正。
(vl-load-com)
(defun C:999 (/)
     (setq LST '(("LINE" "直线")
   ("ARC" "圆弧")
   ("CIRCLE" "圆")
   ("LWPOLYLINE" "多段线")
   ("ELLIPSE" "椭圆")
   ("SPLINE" "样条线")
         )
     )
     (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,ELLIPSE,SPLINE"))
    )
  )
  (progn
      ;;1.逐个统计
      (setq I 0)
      (repeat (sslength SS)
   (setq EN  (ssname SS I)
         ENT (entget EN)
         STR (cdr (assoc 0 ENT))
   )
   (if (setq TMP (assoc STR LST))
       (setq LEN (vlax-curve-getdistatparam
       EN
       (vlax-curve-getendparam EN)
          )
      LST (subst (append TMP (list LEN)) TMP LST)
       )
   )
   (setq I (1+ I))
      )
      ;;2.显示
      (setq PRTXT
        "线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
      )
      (foreach N LST
   (if (> (length N) 2)
       (setq LEN (apply '+ (cddr N))
      PRTXT (strcat PRTXT
      "\n"
      (cadr N)
      "\t"
      (itoa (- (length N) 2))
      "\t"
      (rtos LEN 2 3)
     )
       )
   )
      )

    (setq LL   (rtos (apply '+ (apply 'append (mapcar 'cddr LST))) 2 2))
    (setq HD (getreal "\n请输入零件高度<30>:"))
;;;    (setq JJ (* LL HD 0.0043))           ;;;   修改这一行            
    (setq PRTXT (strcat PRTXT "\n\n总数:"   (itoa (- (length (apply 'append LST)) (* 2 (length LST))))
                                "  总长度:"  LL         
;;;                           "  总价格:"  JJ      ;;;   修改这一行
                     
      )
      )
      (princ PRTXT)
      (alert PRTXT)
  )
     )
     (princ)
)

发表于 2019-1-17 13:22:43 | 显示全部楼层
本帖最后由 fangmin723 于 2019-1-17 13:25 编辑

(setq LL   (rtos (apply '+ (apply 'append (mapcar 'cddr LST))) 2 2))

LL是字符串,你这字符串怎么能进行数学运算啊
;;;    (setq JJ (* LL HD 0.0043))           ;;;   修改这一行  

JJ是实数类型,你却又把他强行与字符串组合
(setq PRTXT (strcat PRTXT "\n\n总数:"   (itoa (- (length (apply 'append LST)) (* 2 (length LST))))
                                "  总长度:"  LL         
;;;                           "  总价格:"  JJ      ;;;   修改这一行
                     
      )

发表于 2019-1-18 01:18:30 | 显示全部楼层
楼主快丝专业....
发表于 2019-1-22 18:53:33 | 显示全部楼层

这是选线计算加工价格,其中红线有错误,水平有限没找到原因,望改正。
(vl-load-com)
(defun C:999 (/)
     (setq LST '(("LINE" "直线")
   ("ARC" "圆弧")
   ("CIRCLE" "圆")
   ("LWPOLYLINE" "多段线")
   ("ELLIPSE" "椭圆")
   ("SPLINE" "样条线")
         )
     )
     (if (setq SS (ssget '((0 . "LINE,ARC,CIRCLE,LWPOLYLINE,ELLIPSE,SPLINE"))
    )
  )
  (progn
      ;;1.逐个统计
      (setq I 0)
      (repeat (sslength SS)
   (setq EN  (ssname SS I)
         ENT (entget EN)
         STR (cdr (assoc 0 ENT))
   )
   (if (setq TMP (assoc STR LST))
       (setq LEN (vlax-curve-getdistatparam
       EN
       (vlax-curve-getendparam EN)
          )
      LST (subst (append TMP (list LEN)) TMP LST)
       )
   )
   (setq I (1+ I))
      )
      ;;2.显示
      (setq PRTXT
        "线条长度分类统计\n\n类型\t根数\t长度\n----------------------"
      )
      (foreach N LST
   (if (> (length N) 2)
       (setq LEN (apply '+ (cddr N))
      PRTXT (strcat PRTXT
      "\n"
      (cadr N)
      "\t"
      (itoa (- (length N) 2))
      "\t"
      (rtos LEN 2 3)
     )
       )
   )
      )

    (setq LL    (apply '+ (apply 'append (mapcar 'cddr LST))) )
    (setq HD (getreal "\n请输入零件高度<30>:"))
    (setq JJ (* ll(* HD(* 0.0043)))  )         ;;;   修改这一行            
    (setq PRTXT (strcat PRTXT "\n\n总数:"   (itoa (- (length (apply 'append LST)) (* 2 (length LST))))
                                "  总长度:" (rtos LL  2 2)      

                           "  总价格:"  (rtos JJ  2 2)    ;;;   修改这一行
                     
      )
      )
      (princ PRTXT)
      (alert PRTXT)
  )
     )
     (princ)
)
发表于 2024-7-17 22:27:49 | 显示全部楼层
雷雨线割报价软件

本帖子中包含更多资源

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

x
发表于 2024-7-18 05:18:54 来自手机 | 显示全部楼层
flfcegu168 发表于 2024-7-17 22:27
雷雨线割报价软件

牛逼。现在这个多少钱
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-25 11:56 , Processed in 0.200855 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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