LISP计算多行文字和多段线
你好我一直在使用下面的LISP，这是在这个论坛上人们的善意帮助下拼凑起来的。。。。。。
(defun C:checklabel ( / SSX txt )
(foreach x '(63 90 125 180 250 315)
(if (setq SSX (ssget "_X" (list (cons 0 "MTEXT")(cons 1 (setq txt (strcat (itoa x) "mm PE")))(if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
(princ (strcat "\nThere are " (itoa (sslength SSX)) " MTEXT objects with content \"" txt "\" on the current tab."))
)
)
(princ)
)
我有一个修改，我想添加，但我正在努力。
当前代码统计图形上具有特定值（63mm PE/90mm PE/125mm PE）等的多行文字。
每个多行文字都从多段线偏移（每个多行文字都标记了管道每个部分的大小）。我想知道是否可以通过查看“0gas”层上距离每种多行文字最近的多段线来列出每种类型多行文字的多段线总长度。
因此，当您运行该命令时，它会说：
（当前选项卡上有48个多行文字对象，内容为“63mm PE”，长度为110.5m）。
（当前选项卡上有20个内容为“90mm PE”的多行文字对象，长度为90.2m）
这对我来说太先进了，但对某些人来说可能是一个很好的挑战！
绝对可行。
张贴一张样品图，让我们看看我们在这里处理什么。
这些数字代表多段线的真实长度吗？那就容易多了。
pBe公司
我附上了一张图纸，不幸的是，63mm是指管道的直径（我需要例行查看每个管道的长度）。
图纸上有14.1m的90mm PE（1 x管道长度）和34.17m的63mm PE（2 x管道长度）。希望这有意义！
谢谢
测验图纸
当前选项卡上有2个多行文字对象，内容为“63mm PE”，长度为34.17m。
当前选项卡上有1个内容为“90mm PE”的多行文字对象，长度为14.18m。
那么它的总长度都是“63mm PE”对吗？
是的，这是正确的。
我需要它列出每种标签类型的总长度，
即
（当前选项卡上有2个内容为“63mm PE”的多行文字对象，总长度为34.17m）。
（当前选项卡上有1个内容为“90mm PE”的多行文字对象，长度为14.18m）
在我绘制的每个图形上都有一个管道网络（多段线），每个管道都有多行文字标签来显示直径。因此，这将是我检查每个管道直径（63mm/90mm/125mm/180mm）总长度的一个好方法
(defun C:demo(/ ss i pl_list mt_list mtpt_list sn a b c d e f g h tmp _nearest thelenght)
(setq _relist (lambda (m)
((if m vl-remove-if vl-remove-if-not) '(lambda (x)
(equal (car f) (car x))) g)))
(if (setq ss (ssget
'((410 . "Model")(8 . "0gas")
(-4 . "<OR")
(-4 . "<AND")(0 . "MTEXT")(1 . "#*")
(-4 . "AND>") (0 . "LWPOLYLINE") (-4 . "OR>")))
)
(progn
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(if (eq (cdr (assoc 0 (setq ent (entgetsn)))) "LWPOLYLINE")
(setq pl_list (cons (list (vlax-curve-getDistAtParam sn
(vlax-curve-getendparam sn)) sn ) pl_list))
(setq mt_list (cons (list (cdr (assoc 10 ent)) (atoi (cdr (assoc 1 ent)))) mt_list))
)
)
(while (and (setq a (car mt_list)) pl_list)
(setq tmp (mapcar '(lambda (c)
(list c (distance (car a)
(vlax-curve-getClosestPointTo (cadr c) (car a)))
(car c) (cadr a)))pl_list))
(setq _nearest (car (vl-sort tmp '(lambda ( d e )
(< (cadr d) (cadr e)))))
pl_list (vl-remove (Car _nearest) pl_list)
mtpt_list (cons (list (cadddr _nearest) (caddr _nearest)) mtpt_list)
mt_list (cdr mt_list))
)
(setq mtpt_list (vl-sort mtpt_list
'(lambda (u v)
(< (car u) (car v))
)
)
)
(while (setq f (car mtpt_list))
(setq g (cdr mtpt_list))
;;; Modified ;;;
(setq thelenght (rtos
(if (setq h (_relist nil))
(progn
(setq g (_relist t))
(apply '+ (mapcar 'cadr (cons f h))))
(cadr f)) 2 0))
;;; Lesson for Andy ;;;
;;; OPTION for 0.50 value ;;;
;;; ;;;
;;; (setq thelenght_fix (fix thelenght)) ;;;
;;; (setq thelenght_rem (rem thelenght thelenght_fix)) ;;;
;;; (setq thelenght ;;;
;;; (itoa ;;;
;;; (if (>= thelenght_rem 0.50) ;;;
;;; (1+ thelenght_fix) ;;;
;;; thelenght_fix))) ;;;
;;; ;;;
;;; Lesson for Andy ;;;
(princ (strcat "\nThere are "
(itoa (if h (1+ (length h)) 1))
" MTEXT objects with content \""
(itoa (car f))
"mm PE\" on the current tab and the "
(if h "total " "")
"length is " thelenght"m."))
(setq mtpt_list g)
)
)
)
(princ)
)
这只是一种方法，还有其他选择，比如使用层名称而不是“0gas”，它可以是“63mm PE gas”，或者我们甚至可以使用扩展数据
你是怎么给这些普林斯贴上标签的？你使用程序了吗？我们可以修改该代码（如果您确实有）来分配扩展数据或使用层名称thingy，这是您的选择。
试试我发布的演示，看看这是否足以满足您的要求
HTH公司
编辑：舍入最接近1的总数
编辑：RTOS从2 2到2 0 1 好代码pBe。
让我们希望这幅画没有任何多行文字对象，没有任何女朋友，我的意思是一条多段线，这可能会迫使程序产生奇怪的结果。
谢谢塔瓦。
塔瓦特有这样的风险，这就是为什么我为OP提出了其他选择。配对将是一个头痛的问题。[可能删除“_X”并强制用户选择对象]
这也是为什么我问OP他们如何标记多段线的原因，我们可以强制对象遵循某个条件（
无论如何，我们总是可以编写另一个代码
pBe公司
想知道实际的绘画到底有多复杂。。。。
哇，谢谢！这正是我想要的。只是一个小小的调整（希望如此）。有时标签可能略有不同（63mm Pe/63 Pe/63 Pe）。其中一个原因是，有时管道的长度可能很短，因此可以删除“mm”以使其适合。
有没有办法改变它来寻找这些变化？查找多行文字开头的数字可能更容易，因为“0gas”层上不应该有任何其他会干扰的文字。
我目前使用Lee Mac dynamic label LISP标记每个多段线。
真为你高兴。
我会让你先尝试一下，然后告诉我们你的想法。我们从那里接过去。
我来看看，我们可以使用LMs程序来确定如何为演示代码收集数据。
页:
[1]
2