万事如意 发表于 2023-12-30 10:42:08

你好哪位大神能帮我把压缩包里的统计工作量Lisp插件帮我修改一下能在CAD2024上运行

本帖最后由 万事如意 于 2024-1-2 08:16 编辑

你好哪位大神能帮我把CAD插件统计工作量Lisp插件代码帮我修改一下能在CAD2024上运行,现在的代码只能在CAD低版本上运行,我要在CAD2024高版本上运行,总共两个Lisp插件代码麻烦哪位大神帮我修改一下谢谢。
https://wwvt.lanzoum.com/iItFb1jcyx2h

第一个插件代码:

(defun c:zz()
(if *error* quit)
(setq cmdmode (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq myosmode (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\n选择计算工作量对象: ")
(setq sset (ssget))
(if (null sset)
(princ "\n错误: 没有选择对象!\n")
;过滤出选中的“text”实体nsset。
(progn
(setq ssl (sslength sset))
(setq nsset (ssadd)) ;“text”实体
(setq nsset1 (ssadd)) ;工作量实体
(setq nsset2 (ssadd)) ;光、电缆程式实体
(while (> ssl 0)
(setq temp (ssname sset (setq ssl(1- ssl))))
(if (= (cdr (assoc 0 (entget temp))) "TEXT")
    (ssadd temp nsset)
)
)
(setq ssl (sslength nsset))
;选出形如"墙20+架10"的对象和"HYA10*0.4"。
(setq total 0)
(setq ssl1 ssl)
(setq ssl2 ssl)
(while (> ssl1 0)
(setq temp (ssname nsset (setq ssl1 (1- ssl1))))
(setq txt0 (cdr (assoc 1 (entget temp))))
(selecttxt_dlcs)
(selecttxt_gzl)
)))
(gzl_duihao)
(gzl_guilei)
(gzl_culture)
(gzl_viewresult)
(setvar "OSMODE" myosmode)
(setvar "CMDECHO" cmdmode)
(prin1)
)

;;;选出形如"墙20+架10"
(defun selecttxt_gzl()
(setq re_call 0)
(setq txt_l (strlen txt0))
;形如"墙2*******"
(if (> txt_l 2)
    (if (and (> (ascii (substr txt0 1 1)) 128) (> (ascii (substr txt0 2 1)) 128) (< (ascii (substr txt0 3 1)) 58) (> (ascii (substr txt0 3 1)) 47))
    (progn
      (setq txt0 (substr txt0 3 (- txt_l 2)))
      (setq re_call 1)
   )))
;形如"20.5+******"
;形如"20.5"
(if (and (< (ascii (substr txt0 1 1)) 58) (> (ascii (substr txt0 1 1)) 47) (= re_call 0))
    (progn
       (setq i 0)
       (while (< i txt_l)
            (setq i (1+ i))
            (setq txt_it (ascii (substr txt0 i 1)))
            (if (and (= txt_it 43) (< i txt_l))
            (progn
                (setq txt0 (substr txt0 (+ i 1) (- txt_l i)))
                (setq i txt_l)
                (setq re_call 1)))
            (if (and (or (> txt_it 57) (< txt_it 43) (= txt_it 44) (= txt_it 45) (= txt_it 47)) (= re_call 0))
            (progn
                (setq i txt_l)
                (setq re_call 2)))
            (if (and (= i txt_l) (= re_call 0))
                (if (and (< txt_it 58) (> txt_it 47))
                (ssadd temp nsset1))
             )
      )
   )
)
(if (= re_call 1) (selecttxt_gzl))
)

;;;选出"HYA"、"GYT"、"GYF"文字数
(defun selecttxt_dlcs()
(setq txt_l (strlen txt0))
(if (> txt_l 3)
    (if (or (= (substr txt0 1 3) "HYA") (= (substr txt0 1 2) "GY") (= (substr txt0 1 2) "GG") (= (substr txt0 1 2) "PE") (= (substr txt0 1 2) "SC")(= (substr txt0 1 4) "钢管")(= (substr txt0 1 4) "硅管"))
    (ssadd temp nsset2))
)
)

;;;工作量与电缆程式对号
(defun gzl_duihao()
(setq duihao_ls1 nil)
(setq duihao_ls2 nil)
(setq nsset1_len (sslength nsset1))
(while (> nsset1_len 0)
    (setq duihao_yes 0)
    (setq nsset1_temp (ssname nsset1 (setq nsset1_len (1- nsset1_len))))
    (setq nsset1_rd (cdr (assoc 50 (entget nsset1_temp))))
    (setq nsset1_pt (cdr (assoc 10 (entget nsset1_temp))))
    (setq nsset1_pt (list (car nsset1_pt) (cadr nsset1_pt)))
    (setq nsset2_len (sslength nsset2))
          (while (> nsset2_len 0)
                (setq nsset2_temp (ssname nsset2 (setq nsset2_len (1- nsset2_len))))
            (setq nsset2_rd (cdr (assoc 50 (entget nsset2_temp))))
            (if (or (< (abs (- nsset1_rd nsset2_rd)) 0.1) (> (abs (- nsset1_rd nsset2_rd)) 6.2))
            (progn
                        (setq nsset2_pt (cdr (assoc 10 (entget nsset2_temp))))
                            (setq nsset2_pt (list (car nsset2_pt) (cadr nsset2_pt)))
                      (setq dis_n1n2 (distance nsset1_pt nsset2_pt))
                      (if (< dis_n1n2 12)         ;指定插入点间距范围
                        (progn
                               (setq n1n2_rd (- (angle nsset2_pt nsset1_pt) nsset1_rd))
                           (setq dis_yn1n2 (abs (* dis_n1n2 (sin n1n2_rd))))
                           (if (and (< dis_yn1n2 5) (>= n1n2_rd 0) (<= n1n2_rd Pi))
                              (progn
                                 (setq duihao_yes 1)
                                 (setq nsset2_temp1 nsset2_temp))
                           (if (and (< dis_yn1n2 5) (= duihao_yes 0))
                              (progn
                                 (setq duihao_yes 1)
                                 (setq nsset2_temp1 nsset2_temp))
                           ))
                        ))
               )      
            )
      )
      (if (= duihao_yes 0)
               (progn
                   (setq duihao_lstemp nil)
                   (setq duihao_lstemp (cdr (assoc 1 (entget nsset1_temp))))
                   (setq duihao_ls2 (cons duihao_lstemp duihao_ls2))
      ))
      (if (= duihao_yes 1)
               (progn
                  (setq duihao_lstemp nil)
                  (setq duihao_lstemp (cons (cdr (assoc 1 (entget nsset2_temp1))) (cdr (assoc 1 (entget nsset1_temp)))))
                  (setq duihao_ls1 (cons duihao_lstemp duihao_ls1))
                  (ssdel nsset2_temp1 nsset2)
      ))
    )
)

;归类
(defun gzl_guilei(/ guilei_temp1 guilei_temp2 guilei_temp3 guilei_temp4)
(setq guilei_temp1 duihao_ls1)
(setq guilei_result nil)
(while (/= guilei_temp1 nil)
   (setq guilei_temp2 (car guilei_temp1))
   (setq guilei_temp3 (car guilei_temp2))
   (setq guilei_temp1 (cdr guilei_temp1))
   (if (/= guilei_result nil)
      (progn
         (if (/= (assoc guilei_temp3 guilei_result) nil)
             (progn
               (setq guilei_temp4 (cdr guilei_temp2))
               (setq guilei_temp4 (strcat (cdr (assoc guilei_temp3 guilei_result)) "+" guilei_temp4))
               (setq guilei_result (subst (cons guilei_temp3 guilei_temp4) (assoc guilei_temp3 guilei_result) guilei_result))
             )
         (setq guilei_result (cons guilei_temp2 guilei_result)))
      )
      (setq guilei_result (cons guilei_temp2 guilei_result)))
)
)

;计算工作量文字
(defun gzl_culture(/ cu_temp1 cu_temp2 cu_temp3 cu_temp4 cu_temp5 cu_temp6 cu_temp7 cu_temp8)
(setq cu_result nil)
(setq cu_temp1 guilei_result)
(while (/= cu_temp1 nil)
   (setq cu_temp6 nil)
   (setq cu_temp2 (car cu_temp1))
   (setq cu_temp3 (cdr cu_temp2))
   (setq cu_temp1 (cdr cu_temp1))
   (while (> (setq cu_te3_len (strlen cu_temp3)) 0)
         (setq i 0)
         (while (< i cu_te3_len)
             (setq i (1+ i))
             (setq cu_temp4 (substr cu_temp3 i 1))
             (if (= cu_temp4 "+")
               (progn
                   (setq cu_temp5 (substr cu_temp3 1 (- i 1)))
                   (setq cu_temp3 (substr cu_temp3 (+ i 1)))
                   (setq i cu_te3_len)
                )
            (if (= i cu_te3_len)
                (progn
                  (setq cu_temp5 cu_temp3)
                  (setq cu_temp3 ""))))
         )
         (if (and (< (ascii (substr cu_temp5 1 1)) 58) (> (ascii (substr cu_temp5 1 1)) 47))
         (setq cu_temp7 (cons " " cu_temp5))
         (setq cu_temp7 (cons (substr cu_temp5 1 2) (substr cu_temp5 3))))
         (if (or (= cu_temp6 nil) (= (assoc (car cu_temp7) cu_temp6) nil))
            (setq cu_temp6 (cons cu_temp7 cu_temp6))
            (progn
               (setq cu_temp8 (rtos (+ (atof (cdr (assoc (car cu_temp7) cu_temp6))) (atof (cdr cu_temp7)))))
               (setq cu_temp6 (subst (cons (car cu_temp7) cu_temp8) (assoc (car cu_temp7) cu_temp6) cu_temp6))
            ))
    )
    (setq cu_result (cons (cons (car cu_temp2) cu_temp6) cu_result))
)
)


;显示结果
(defun gzl_viewresult(/ viere_temp1 viere_temp2)
(setq viere_temp1 cu_result)
(while (/= viere_temp1 nil)
      (setq viere_temp2 (car viere_temp1))
      (setq viere_temp1 (cdr viere_temp1))
      (princ viere_temp2)
      (princ "\n")
)
(if (= duihao_ls2 nil)
(princ "无可疑数据,图纸很标准。")
(progn
      (princ "以下数据为可疑数据,请认真核对:\n")
      (princ duihao_ls2)
))
)


第二个插件代码:

(defun c:uu (/ hz lst pt ss txt txt1 var x xw y)
(if (and
      (xdrx_initssget "\n选取要统计的文字<退出>:")
      (setq ss (xdrx_ssget '((0 . "TEXT"))))
      )
    (progn
      (xdrx_begin)
      (xdrx_sysvar_push '("dimzin" 0))
      (setq lst (mapcar
                  '(lambda (x)
                     (setq txt (xdrx_getpropertyvalue x "textstring"))
                     (setq txt1 (xd::string:regexps "[\\u4e00-\\u9fa5]{1,}+"
                                                    txt ""
                              )
                     )
                     (if txt1
                     (setq lst (mapcar
                                 '(lambda (y)
                                    (setq hz (xd::string:regexps "[\\u4e00-\\u9fa5]{0,}"
                                                                   y ""
                                             )
                                    )
                                    (setq xw (xd::string:regexps "(-?+)(\\.+)?"
                                                                   y ""
                                             )
                                    )
                                    (list (car hz) (atof (car xw)))
                                    )
                                 txt1
                                 )
                     )
                     )
                   )
                  (xdrx_pickset->ents ss)
                )
            lst (apply
                  'append
                  lst
                )
            lst (xd::list:groupbyindex lst 0.1)
            lst (vl-sort lst '(lambda (x y)
                              (< (car x) (car y))
                              )
                )
            lst (mapcar
                  '(lambda (x)
                     (list (car x) (rtos (apply
                                           '+
                                           (cdr x)
                                       ) 2 1
                                 )
                     )
                   )
                  lst
                )
            lst (append lst (list (list "合计" (rtos (apply '+ (mapcar '(lambda(x)(atof (cadr x))) lst)) 2 1))))
            lst (append
                  (list (list "统计表" nil) '("名 称" "数 量"))
                  lst
                )
      )
      (if (not #miaomu-tj-height)
      (setq #miaomu-tj-height 3.5)
      )
      (if (setq var (getreal (xdrx_prompt "\n字高<" #miaomu-tj-height ">:" t)))
      (setq #miaomu-tj-height var)
      )
      (if (setq pt (getpoint "\n表格插入点:"))
      (progn
          (xd::text:init 1)
          (XD::Table:MakeFromList lst pt #miaomu-tj-height (/ #miaomu-tj-height
                                                            2.0
                                                         )
          )
      )
      )
      (xdrx_sysvar_pop)
      (xdrx_end)
    )
)
(princ)
)


mashanjie 发表于 2023-12-30 20:57:35

为什么不下载下来,把代码发出现呢?就搞个链接别人还要去下载

万事如意 发表于 2024-1-2 08:06:31

mashanjie 发表于 2023-12-30 20:57
为什么不下载下来,把代码发出现呢?就搞个链接别人还要去下载

你好大神代码:(defun c:zz()
(if *error* quit)
(setq cmdmode (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq myosmode (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\n选择计算工作量对象: ")
(setq sset (ssget))
(if (null sset)
(princ "\n错误: 没有选择对象!\n")
;过滤出选中的“text”实体nsset。
(progn
(setq ssl (sslength sset))
(setq nsset (ssadd)) ;“text”实体
(setq nsset1 (ssadd)) ;工作量实体
(setq nsset2 (ssadd)) ;光、电缆程式实体
(while (> ssl 0)
(setq temp (ssname sset (setq ssl(1- ssl))))
(if (= (cdr (assoc 0 (entget temp))) "TEXT")
    (ssadd temp nsset)
)
)
(setq ssl (sslength nsset))
;选出形如"墙20+架10"的对象和"HYA10*0.4"。
(setq total 0)
(setq ssl1 ssl)
(setq ssl2 ssl)
(while (> ssl1 0)
(setq temp (ssname nsset (setq ssl1 (1- ssl1))))
(setq txt0 (cdr (assoc 1 (entget temp))))
(selecttxt_dlcs)
(selecttxt_gzl)
)))
(gzl_duihao)
(gzl_guilei)
(gzl_culture)
(gzl_viewresult)
(setvar "OSMODE" myosmode)
(setvar "CMDECHO" cmdmode)
(prin1)
)

;;;选出形如"墙20+架10"
(defun selecttxt_gzl()
(setq re_call 0)
(setq txt_l (strlen txt0))
;形如"墙2*******"
(if (> txt_l 2)
    (if (and (> (ascii (substr txt0 1 1)) 128) (> (ascii (substr txt0 2 1)) 128) (< (ascii (substr txt0 3 1)) 58) (> (ascii (substr txt0 3 1)) 47))
    (progn
      (setq txt0 (substr txt0 3 (- txt_l 2)))
      (setq re_call 1)
   )))
;形如"20.5+******"
;形如"20.5"
(if (and (< (ascii (substr txt0 1 1)) 58) (> (ascii (substr txt0 1 1)) 47) (= re_call 0))
    (progn
       (setq i 0)
       (while (< i txt_l)
          (setq i (1+ i))
          (setq txt_it (ascii (substr txt0 i 1)))
            (if (and (= txt_it 43) (< i txt_l))
              (progn
                (setq txt0 (substr txt0 (+ i 1) (- txt_l i)))
                (setq i txt_l)
                (setq re_call 1)))
            (if (and (or (> txt_it 57) (< txt_it 43) (= txt_it 44) (= txt_it 45) (= txt_it 47)) (= re_call 0))
              (progn
                (setq i txt_l)
                (setq re_call 2)))
          (if (and (= i txt_l) (= re_call 0))
                (if (and (< txt_it 58) (> txt_it 47))
                (ssadd temp nsset1))
             )
        )
   )
)
(if (= re_call 1) (selecttxt_gzl))
)

;;;选出"HYA"、"GYT"、"GYF"文字数
(defun selecttxt_dlcs()
(setq txt_l (strlen txt0))
(if (> txt_l 3)
    (if (or (= (substr txt0 1 3) "HYA") (= (substr txt0 1 2) "GY") (= (substr txt0 1 2) "GG") (= (substr txt0 1 2) "PE") (= (substr txt0 1 2) "SC")(= (substr txt0 1 4) "钢管")(= (substr txt0 1 4) "硅管"))
    (ssadd temp nsset2))
)
)

;;;工作量与电缆程式对号
(defun gzl_duihao()
(setq duihao_ls1 nil)
(setq duihao_ls2 nil)
(setq nsset1_len (sslength nsset1))
(while (> nsset1_len 0)
    (setq duihao_yes 0)
    (setq nsset1_temp (ssname nsset1 (setq nsset1_len (1- nsset1_len))))
    (setq nsset1_rd (cdr (assoc 50 (entget nsset1_temp))))
    (setq nsset1_pt (cdr (assoc 10 (entget nsset1_temp))))
    (setq nsset1_pt (list (car nsset1_pt) (cadr nsset1_pt)))
    (setq nsset2_len (sslength nsset2))
        (while (> nsset2_len 0)
              (setq nsset2_temp (ssname nsset2 (setq nsset2_len (1- nsset2_len))))
          (setq nsset2_rd (cdr (assoc 50 (entget nsset2_temp))))
          (if (or (< (abs (- nsset1_rd nsset2_rd)) 0.1) (> (abs (- nsset1_rd nsset2_rd)) 6.2))
              (progn
                        (setq nsset2_pt (cdr (assoc 10 (entget nsset2_temp))))
                            (setq nsset2_pt (list (car nsset2_pt) (cadr nsset2_pt)))
                    (setq dis_n1n2 (distance nsset1_pt nsset2_pt))
                      (if (< dis_n1n2 12)         ;指定插入点间距范围
                      (progn
                             (setq n1n2_rd (- (angle nsset2_pt nsset1_pt) nsset1_rd))
                           (setq dis_yn1n2 (abs (* dis_n1n2 (sin n1n2_rd))))
                           (if (and (< dis_yn1n2 5) (>= n1n2_rd 0) (<= n1n2_rd Pi))
                           (progn
                                 (setq duihao_yes 1)
                               (setq nsset2_temp1 nsset2_temp))
                             (if (and (< dis_yn1n2 5) (= duihao_yes 0))
                               (progn
                                 (setq duihao_yes 1)
                               (setq nsset2_temp1 nsset2_temp))
                             ))
                        ))
             )       
          )
        )
      (if (= duihao_yes 0)
                 (progn
                   (setq duihao_lstemp nil)
                   (setq duihao_lstemp (cdr (assoc 1 (entget nsset1_temp))))
                   (setq duihao_ls2 (cons duihao_lstemp duihao_ls2))
        ))
        (if (= duihao_yes 1)
                 (progn
                  (setq duihao_lstemp nil)
                  (setq duihao_lstemp (cons (cdr (assoc 1 (entget nsset2_temp1))) (cdr (assoc 1 (entget nsset1_temp)))))
                  (setq duihao_ls1 (cons duihao_lstemp duihao_ls1))
                  (ssdel nsset2_temp1 nsset2)
        ))
    )
)

;归类
(defun gzl_guilei(/ guilei_temp1 guilei_temp2 guilei_temp3 guilei_temp4)
(setq guilei_temp1 duihao_ls1)
(setq guilei_result nil)
(while (/= guilei_temp1 nil)
   (setq guilei_temp2 (car guilei_temp1))
   (setq guilei_temp3 (car guilei_temp2))
   (setq guilei_temp1 (cdr guilei_temp1))
   (if (/= guilei_result nil)
      (progn
           (if (/= (assoc guilei_temp3 guilei_result) nil)
             (progn
                 (setq guilei_temp4 (cdr guilei_temp2))
                 (setq guilei_temp4 (strcat (cdr (assoc guilei_temp3 guilei_result)) "+" guilei_temp4))
               (setq guilei_result (subst (cons guilei_temp3 guilei_temp4) (assoc guilei_temp3 guilei_result) guilei_result))
             )
           (setq guilei_result (cons guilei_temp2 guilei_result)))
        )
      (setq guilei_result (cons guilei_temp2 guilei_result)))
)
)

;计算工作量文字
(defun gzl_culture(/ cu_temp1 cu_temp2 cu_temp3 cu_temp4 cu_temp5 cu_temp6 cu_temp7 cu_temp8)
(setq cu_result nil)
(setq cu_temp1 guilei_result)
(while (/= cu_temp1 nil)
   (setq cu_temp6 nil)
   (setq cu_temp2 (car cu_temp1))
   (setq cu_temp3 (cdr cu_temp2))
   (setq cu_temp1 (cdr cu_temp1))
   (while (> (setq cu_te3_len (strlen cu_temp3)) 0)
         (setq i 0)
         (while (< i cu_te3_len)
             (setq i (1+ i))
             (setq cu_temp4 (substr cu_temp3 i 1))
             (if (= cu_temp4 "+")
             (progn
                   (setq cu_temp5 (substr cu_temp3 1 (- i 1)))
                   (setq cu_temp3 (substr cu_temp3 (+ i 1)))
                   (setq i cu_te3_len)
                )
              (if (= i cu_te3_len)
                (progn
                  (setq cu_temp5 cu_temp3)
                  (setq cu_temp3 ""))))
       )
       (if (and (< (ascii (substr cu_temp5 1 1)) 58) (> (ascii (substr cu_temp5 1 1)) 47))
           (setq cu_temp7 (cons " " cu_temp5))
           (setq cu_temp7 (cons (substr cu_temp5 1 2) (substr cu_temp5 3))))
       (if (or (= cu_temp6 nil) (= (assoc (car cu_temp7) cu_temp6) nil))
          (setq cu_temp6 (cons cu_temp7 cu_temp6))
          (progn
                 (setq cu_temp8 (rtos (+ (atof (cdr (assoc (car cu_temp7) cu_temp6))) (atof (cdr cu_temp7)))))
               (setq cu_temp6 (subst (cons (car cu_temp7) cu_temp8) (assoc (car cu_temp7) cu_temp6) cu_temp6))
          ))
    )
    (setq cu_result (cons (cons (car cu_temp2) cu_temp6) cu_result))
)
)


;显示结果
(defun gzl_viewresult(/ viere_temp1 viere_temp2)
(setq viere_temp1 cu_result)
(while (/= viere_temp1 nil)
      (setq viere_temp2 (car viere_temp1))
      (setq viere_temp1 (cdr viere_temp1))
      (princ viere_temp2)
      (princ "\n")
)
(if (= duihao_ls2 nil)
(princ "无可疑数据,图纸很标准。")
(progn
      (princ "以下数据为可疑数据,请认真核对:\n")
      (princ duihao_ls2)
))
)

yshf 发表于 2024-1-2 11:28:50

测试图怎么不发上来?
页: [1]
查看完整版本: 你好哪位大神能帮我把压缩包里的统计工作量Lisp插件帮我修改一下能在CAD2024上运行