希望大神帮忙修改下面这个lisp,谢谢！

eddydqiao

下面这个lisp是搜集过来的一个有用程序，主要用于核对图纸工程量，一般市政排水管网中，会在平面上对管线进行标注，标注格式为DN300(管径)-3(坡度)-30(管长)或者DN300(管径)-30(管长)-3(坡度），下面这个lisp程序可以一次多选图面中所有的平面管线标注，然后输入任意管径，可以给你统计出管长部分的总和，遗憾的是，这个程序只对“DN300(管径)-3(坡度)-30(管长)”的标注方式有效，当坡度和管长的位置互换时则无法统计总和；请大神帮忙修改下，使得程序能变成对“DN300(管径)-30(管长)-3(坡度)"的标注形式有效，能统计所有同管径的管长总和。谢谢！

源程序如下：
;本段程序帮你统计排水管道管长工程量。但前提是格式为“(DN***-**-***)
(Defun c:tps (/ sum sm sumst sc1 sc fil n e ed et j tzh tzh2 len ln)
(command "redraw")

(setq sum 0)
(setq sm 0)
(setq sumst 0)
(setq fil (ssget))
(setq sc1 (getstring "\n请输入需要统计的管径(以DN***表示):\n"))
(setq sc (strcase sc1))
(setq len (sslength fil))
(setq n 0)
(while (<= n (- len 1))                                        ;1
  (progn                                                        ;2
   (setq e (ssname fil n))
   (if (= "TEXT" (cdr (assoc 0 (setq ed (entget e)))))           ;3        过滤出文

本
     (progn                                                        ;4
  (setq et (cdr (assoc 1 (setq ed (entget e))))) ;********
  (setq ln (strlen et))
  (setq j 1)

  (while (< j ln)                                                 ;5
   (if (or (/= sc (substr et 1 j)) (= "0" (substr et (+ 1 j) 1)))        ;6
    (setq j (+ 1 j))
  (progn        ;7
  (setq i 1)                                                        
  (while (< i ln)                ;8 截取单管管长
    (setq tzh (substr et i 1))
     (if (= tzh "-")                 ;9
      (progn                         ;10
       (setq i (+ 1 i))
       (while (< i ln)                ;11
          (setq tzh2 (substr et i 1))
          (if (= tzh2 "-")        ;12
        (progn                        ;13
       (setq sm (substr et (+ i 1)))
      (setq sum (+ sum (atof sm)))
        ))                ;13,12
     (setq i (+ 1 i))
        )                        ;11
      )                                ;10
     (setq i (+ 1 i))
        )                        ;9 end if *        
   )                                ;接8
     (setq j (+ 1 j))
    )                                ;接7 progn
   )                                ;接6 if
   )                                ;接5 while

     )                        ;接4 progn
;    (setq n (+ 1 n))
    )                        ;接3 if
    (setq n (+ 1 n))
   )                        ;接2 progn
  )                        ;接1 while
(setq sumst (rtos sum 2))

(princ (strcat "\n\n\t\t totle 排水管径 " sc "= " sumst))

(princ)
)

ZZXXQQ

2. (defun c:tps (/ dat datlst dnlst fil ed et)
   
3. (setvar "CMDECHO" 0)
   
4. (setq datlst (list))
   
5. (setq fil (ssget '((0 . "TEXT")(1 . "DN#*-#*-#*"))));取文本中符合DN***-**-***字串
   
6. (repeat (setq i (sslength fil))
   
7.   (setq ed (entget(ssname fil (setq i (1- i)))))
   
8.   (setq et (cdr (assoc 1 ed)))
   
9.   (setq dat (read(strcat "(" (vl-string-translate "-" " " et) ")"))) ;(DN*** ** **)
   
10.   (setq datlst (cons dat datlst))
    
11. )
    
12. (setq datlst (vl-sort datlst
    
13. '(lambda (a b) (< (vl-princ-to-string (car a)) (vl-princ-to-string (car b))))));排序
    
14. (setq dnlst (list))
    
15. (foreach x datlst
    
16.   (if (not(member (car x) dnlst)) (progn
    
17.    (setq dnlst (cons (car x) dnlst));(DN*** ...)
    
18.    (set (car x) 0.0)
    
19.   ))
    
20.   (set (car x) (+ (apply 'max (cdr x)) (eval(car x))));取大值加入DN***
    
21. )
    
22. (foreach x (reverse dnlst)
    
23.   (write-line (strcat "\n\n\t\t totle 排水管径 " (vl-princ-to-string x) " = " (rtos(eval x))))
    
24. )
    
25. (setvar "CMDECHO" 1)
    
26. (princ)
    
27. )
    

(defun c:tps (/ dat datlst dnlst fil ed et) <br /> (setvar "CMDECHO" 0)<br /> (setq datlst (list))<br /> (setq fil (ssget '((0 . "TEXT")(1 . "DN#*-#*-#*"))));取文本中符合DN***-**-***字串<br /> (repeat (setq i (sslength fil))<br />   (setq ed (entget(ssname fil (setq i (1- i)))))<br />   (setq et (cdr (assoc 1 ed)))<br />   (setq dat (read(strcat "(" (vl-string-translate "-" " " et) ")"))) ;(DN*** ** **)<br />   (setq datlst (cons dat datlst))<br /> )<br /> (setq datlst (vl-sort datlst<br /> '(lambda (a b) (< (vl-princ-to-string (car a)) (vl-princ-to-string (car b))))));排序<br /> (setq dnlst (list))<br /> (foreach x datlst<br />   (if (not(member (car x) dnlst)) (progn<br />    (setq dnlst (cons (car x) dnlst));(DN*** ...)<br />    (set (car x) 0.0)<br />   ))<br />   (set (car x) (+ (apply 'max (cdr x)) (eval(car x))));取大值加入DN***<br /> )<br /> (foreach x (reverse dnlst)<br />   (write-line (strcat "\n\n\t\t totle 排水管径 " (vl-princ-to-string x) " = " (rtos(eval x))))<br /> )<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />

eddydqiao

不行啊，大神，你看下我附近里面的例图，用原来的tps程序，右边的可以统计，左边的不能统计管长。左边的用你帖子里面修改后的代码程序，运行后显示参数错误！

ZZXXQQ

eddydqiao 发表于 2014-11-11 15:11
不行啊，大神，你看下我附近里面的例图，用原来的tps程序，右边的可以统计，左边的不能统计管长。左边的用你 ...

程序改了，再试试。

eddydqiao

ZZXXQQ 发表于 2014-11-11 20:58
程序改了，再试试。

多谢大神，牛！

知行ooo李肖坪

谢谢，同步学习