多引线的块描述

AlexP · 发表于 2022-7-5 15:04:52

嗨，设计师们，

我希望有一个lisp可以读取一个块的描述，并在多重引线上显示它，这样你就不必在块注册后键入文本。

我知道这个话题以前在一篇更老的帖子中有过——大约10年前——但我花了几个小时以不同的方式尝试Lisp，仍然无法100%地实现。

http://www.cadtutor.net/forum/showthread.php?39301-块到多重引线文本

有人能解决这个问题吗？

Emmanuel Delay · 发表于 2022-7-5 15:13:19

以下是我写的：
-客户端选择一个块（我假设它有一个描述，我假设客户端单击一个块…没有反虚拟保护）
-客户现在必须绘制多重引线：两点：箭头+引线
-例程将填充标题，作为块的描述。

命令：SAD（可能是双关语，尽管它只是一个缩写）

copy


(defun getBlockProperties ( #Entsel / )
     (setq #Entsel   (vlax-ename->vla-object (car #Entsel))
           ;; insertion point
           #InsPoint (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-InsertionPoint #Entsel)
                       ) ;_ vlax-variant-value
                     ) ;_ vlax-safearray->list
           ;; block name
           #Name     (vla-get-name #Entsel)
           ;; block description
           #Desc     (vla-get-comments
                       (vla-item
                         (vla-get-blocks
                           (vla-get-activedocument (vlax-get-acad-object))
                         ) ;_ vla-get-blocks
                         #Name
                       ) ;_ vla-item
                     ) ;_ vla-get-comments
     ) ;_ setq
 (list #Name #InsPoint #Desc)
)
;; create Mleader with caption.
(defun wmt (caption / )
 ;;(vl-cmdf "_.MLEADER" PAUSE PAUSE "" "_.TEXTEDIT" "_L")
 (vl-cmdf "_.MLEADER" PAUSE PAUSE  caption)
)
;; Select And get Description
(defun c:sad ( / desc)  
 (setq desc (nth 2 (getBlockProperties (entsel "\nSelect a block: "))))
 (princ "\nNow draw the MLeader:\n")
 (wmt desc)
 (princ)
)

对这个满意吗？

AlexP · 发表于 2022-7-5 15:24:33

几乎

它标识描述，但不会填充标题。

Tharwat · 发表于 2022-7-5 15:27:27

我想这是最简单的。

copy


(defun c:d2ml ( / s d)
 (and (princ "\nPick a block :")
      (setq s (ssget "_+.:S:E" '((0 . "INSERT"))))
      (or (setq d (cdr (assoc 4 (entget (tblobjname "BLOCK" (cdr (assoc 2 (entget (ssname s 0)))))))))
          (alert "Block does not have a description <!>")
          )
      (vl-cmdf "_.Mleader" "\" "\" d)
      )
 (princ)
 )

AlexP · 发表于 2022-7-5 15:33:42

相同的结果。

我不知道为什么它不在描述中。。

Tharwat · 发表于 2022-7-5 15:38:39

你能贴一张包括区块的图纸吗？

AlexP · 发表于 2022-7-5 15:46:08

见附件。
测验图纸

Tharwat · 发表于 2022-7-5 15:53:20

就这样，让我知道。

copy


(defun c:d2ml ( / s d l n e)
 (and (princ "\nPick a block :")
      (setq s (ssget "_+.:S:E" '((0 . "INSERT"))))
      (or (setq d (cdr (assoc 4 (entget (tblobjname "BLOCK" (cdr (assoc 2 (entget (ssname s 0)))))))))
          (alert "Block does not have a description <!>")
          )
      (setq l (entlast))
      (vl-cmdf "_.Mleader" "\" "\" "")
      (and (not (= l (setq n (entlast))))
           (entmod (subst (cons 304 d) (assoc 304 (setq e (entget n))) e))
           )
      )
 (princ)
 )

AlexP · 发表于 2022-7-5 16:00:24

你是传说中的塔尔瓦特！！

它工作得很好，非常感谢！

伊曼纽尔，你试一试，我很感激。

Tharwat · 发表于 2022-7-5 16:06:28

谢谢你的好话AlexP。

随时欢迎你。

[编程交流] 多引线的块描述

发表回复

精选推荐