希望大神帮忙修改下面这个lisp,谢谢！
下面这个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 于 2014-11-11 20:57 编辑
(defun c:tps (/ dat datlst dnlst fil ed et)
(setvar "CMDECHO" 0)
(setq datlst (list))
(setq fil (ssget '((0 . "TEXT")(1 . "DN#*-#*-#*"))));取文本中符合DN***-**-***字串
(repeat (setq i (sslength fil))
(setq ed (entget(ssname fil (setq i (1- i)))))
(setq et (cdr (assoc 1 ed)))
(setq dat (read(strcat "(" (vl-string-translate "-" " " et) ")"))) ;(DN*** ** **)
(setq datlst (cons dat datlst))
)
(setq datlst (vl-sort datlst
'(lambda (a b) (< (vl-princ-to-string (car a)) (vl-princ-to-string (car b))))));排序
(setq dnlst (list))
(foreach x datlst
(if (not(member (car x) dnlst)) (progn
(setq dnlst (cons (car x) dnlst));(DN*** ...)
(set (car x) 0.0)
))
(set (car x) (+ (apply 'max (cdr x)) (eval(car x))));取大值加入DN***
)
(foreach x (reverse dnlst)
(write-line (strcat "\n\n\t\t totle 排水管径 " (vl-princ-to-string x) " = " (rtos(eval x))))
)
(setvar "CMDECHO" 1)
(princ)
)
不行啊，大神，你看下我附近里面的例图，用原来的tps程序，右边的可以统计，左边的不能统计管长。左边的用你帖子里面修改后的代码程序，运行后显示参数错误！
eddydqiao 发表于 2014-11-11 15:11 static/image/common/back.gif
不行啊，大神，你看下我附近里面的例图，用原来的tps程序，右边的可以统计，左边的不能统计管长。左边的用你 ...
程序改了，再试试。 ZZXXQQ 发表于 2014-11-11 20:58 static/image/common/back.gif
程序改了，再试试。
多谢大神，牛！ 谢谢，同步学习
页:
[1]