线长统计计算价格

shopping200

这是选线计算加工价格，其中红线有错误，水平有限没找到原因，望改正。
(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

(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

楼主快丝专业....

不语勿语

这是选线计算加工价格，其中红线有错误，水平有限没找到原因，望改正。
(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)
)

flfcegu168

雷雨线割报价软件

baby绑定命运线

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

牛逼。现在这个多少钱