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（可能是双关语，尽管它只是一个缩写）
 

(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 PAUSEcaption)
)

;; 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

我想这是最简单的。
 

(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

就这样，让我知道。

(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。
 
随时欢迎你。
页: [1]
查看完整版本: 多引线的块描述