klpocska 发表于 2022-7-6 10:54:46

多段线到引线

我在一个层中有很多文本和多段线。如何仅将多段线转换为引线？

alanjt 发表于 2022-7-6 11:08:47

提取每个PLine顶点的XYZ，并相应地绘制引线。

klpocska 发表于 2022-7-6 11:25:31

以及如何为引线附加文本？

Lee Mac 发表于 2022-7-6 11:37:20

用户必须选择要使用的文本。
 
查看vla addLeader函数。

Lee Mac 发表于 2022-7-6 11:48:19

可能是这样的：
 

(defun c:toLeader (/ lst2pt ENT PTS TXT TYP)
(vl-load-com) ;; Lee Mac~24.02.10

(defun lst2pt (lst flag)
   (if lst
   (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
         (lst2pt (if flag (cdddr lst) (cddr lst)) flag))))

(setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
(while
   (progn
   (setq ent (car (entsel "\nSelect Polyline for Leader: ")))

   (cond ((eq 'ENAME (type ent))

            (if (wcmatch (setq typ (cdr (assoc 0 (entget ent)))) "*POLYLINE")
                (progn
                  (setq pts
                  (lst2pt
                      (vlax-get
                        (vlax-ename->vla-object ent) 'Coordinates)

                      (if (eq "POLYLINE" typ) t nil)))

                  (while
                  (progn
                      (setq txt (car (entsel "\nSelect Text for Leader: ")))

                      (cond ((eq 'ENAME (type txt))

                               (if (eq "MTEXT" (cdr (assoc 0 (entget txt))))
                                 (progn
                                 
                                 (vla-AddLeader
                                    
                                     (if (zerop (vla-get-ActiveSpace *doc))
                                       (if (eq :vlax-true (vla-get-mspace *doc))
                                       (vla-get-ModelSpace *doc)
                                       (vla-get-PaperSpace *doc))                                       
                                       (vla-get-ModelSpace *doc))
                                    
                                     (variant
                                       (vlax-safearray-fill
                                       (safearray vlax-vbDouble
                                           (cons 0 (1- (* 3 (length pts)))))
                                       (apply (function append) pts)))
                                    
                                       (vlax-ename->vla-object txt)
                                    
                                     acLineWithArrow)

                                 (entdel ent))

                                 (princ "\n** Object Must be MText **")))))))
               
                (princ "\n** Object Must be a *Polyline **"))))))
(princ))

                                 

mexmr10 发表于 2022-7-6 12:06:23

李Lisp程序。你能不能修改一下，使它不需要文本？只想将多段线更改为引线。可以让lisp将新引线保留在其原始层而不是层“0”上吗？
页: [1]
查看完整版本: 多段线到引线