shopping200 发表于 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)
)

fangmin723 发表于 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      ;;;   修改这一行
                     
      )

ysq101 发表于 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 LL2 2)      

                           "总价格:"(rtos JJ2 2)    ;;;   修改这一行
                     
      )
      )
      (princ PRTXT)
      (alert PRTXT)
)
   )
   (princ)
)

flfcegu168 发表于 2024-7-17 22:27:49

雷雨线割报价软件

baby绑定命运线 发表于 2024-7-18 05:18:54

flfcegu168 发表于 2024-7-17 22:27
雷雨线割报价软件

牛逼。现在这个多少钱
页: [1]
查看完整版本: 线长统计计算价格