社区 › Auto Lisp › 匹配多段线特性t

andfcam 发表于 2022-7-5 16:01:14

匹配多段线特性t

你好
 
我的问题很难表达。希望图像附件可以工作。
 
我有一个表示服务（电、水等）的多段线的二维图形。
在多段线沿线的不同点上，显示服务深度的文本（0.45、1.2等）。
 

 
创建一个可以将文本翻译到适当层的lisp例程的可能性有多大？
 
看这张图片，我想得到。55以匹配红线的属性，以及。75以匹配蓝线的属性。
 
非常感谢。

rlx 发表于 2022-7-5 16:10:29

您好，FCAM，
 
 
欢迎收看CadTutor。
 
 
为什么标准的matchprop命令不适用于您？如果您有许多文本对象，并且它们彼此很接近，那么在尝试同时选择它们时可能会出现问题。
 
 
gr.Rlx

BIGAL 发表于 2022-7-5 16:17:36

你可以使用一个简单的“F”选项，围栏。使用lisp将是最简单的，它需要三个部分：第一个是pline获取制作围栏选项所需的所有点；第二个是使用ssget获取文本；第三个是更改属性。
 

;find objects along a pline and change layer
; By Alan H Sep 2017
(defun c:t2lay ( /co-ordsxy)
; pline co-ords example
; By Alan H
(defun getcoords ( ent)
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property ent "Coordinates"
))))

; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(defun co-ords2xy ()
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here

(setq ent (vlax-ename->vla-object (car (entsel "\nPlease pick pline"))))
(setq lay (vla-get-layer ent)) ; layer of pline
(setq co-ords (getcoords ent)) ; co ords of pline
(co-ords2xy) ; make into a paired list x y
(setq ss (ssget "f" co-ordsxy (list (cons 0 "*Text")) )) ; pick all text crossing pline
(if (/= ss nil)
(command "chprop" ss "" "layer" lay "") ; change layer
(alert "No text found")
)
)

rlx 发表于 2022-7-5 16:30:12

 
 
真不错，大阿！
 
 
只有一个（非常）小的项目，如果没有找到文本，ss将为零，chprop可能会失败（如果ss（命令等…）但那只是吹毛求疵（对不起）。非常方便，很酷！
 
 
gr.Rlx

ronjonp 发表于 2022-7-5 16:36:19

下面是另一个与该层匹配的选项：
(defun c:layerityo (/ _mp mp s txts)
(defun _mp (o / ll ur)
   (if        (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'll 'ur))))
   (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
)
   (mapcar (function (lambda (p) (/ p 2.))) (mapcar '+ ll ur))
   )
)
(if (and (setq s (ssget "_X" '((0 . "*polyline"))))
   (setq s (mapcar 'cadr (ssnamex s)))
   (setq txts (ssget ":L" '((0 . "*text"))))
   )
   (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex txts)))
   (if (setq mp (_mp (vlax-ename->vla-object txt)))
(entmod
(subst
    (cons 8
          (caar        (vl-sort (mapcar '(lambda (x)
                                  (list (cdr (assoc 8 (entget x)))
                                          (distance mp (vlax-curve-getclosestpointto x mp))
                                  )
                                  )
                               s
                       )
                       '(lambda (a b) (< (cadr a) (cadr b)))
                )
          )
    )
    (assoc 8 (entget txt))
    (entget txt)
)
)
   )
   )
)
(princ)
)
(vl-load-com)

rlx 发表于 2022-7-5 16:42:50

 
给人印象深刻的

ronjonp 发表于 2022-7-5 16:53:36

谢谢

BIGAL 发表于 2022-7-5 16:55:32

正如所指出的，我需要花几分钟的时间，在我得到一些工作添加错误检查更改CHPROP以上还需要检查它是一条直线或普林线，还是一个圆弧等可以添加为一个更全局的例行程序。选择全部可以被添加，而不是像罗恩乔普那样一次只选一个。

andfcam 发表于 2022-7-5 17:04:08

很抱歉回复得太晚，我一直不在。
 
我感谢所有的反馈——这正是我想要的。我现在将尝试解决方案。
 
非常感谢你！

查看完整版本: 匹配多段线特性t