Lisp请求-单击块

sinnerboy · 发表于 2022-7-6 08:02:42

是否有一个lisp，当你点击一个块时，你会得到一个说明块名的文本粘贴？

stevesfr · 发表于 2022-7-6 08:10:59

给你。

嗯，史蒂夫
区块名称。lsp

sinnerboy · 发表于 2022-7-6 08:17:14

：D:D

非常感谢

stevesfr · 发表于 2022-7-6 08:18:55

不客气！玩得高兴

Dadgad · 发表于 2022-7-6 08:26:16

这是一个非常有用的小工具，谢谢史蒂夫！

有人知道需要如何修改以在paperspace而不是modelspace中添加文本吗？

pBe · 发表于 2022-7-6 08:31:03

不知道你是什么意思那个爸爸

匿名名称友好

copy

(defun c:BlockName (/ #Ent #Point)
[color=blue](vl-load-com)      
[/color]  (and
   [color=blue](setq #Ent (ssget "_:S:E" '((0 . "INSERT"))))
[/color]    (setq #Point (getpoint "\nSpecify placement point for MText: "))
   (entmake (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 7 (getvar "textstyle"))
              (cons 10 (trans #Point 1 0))
              (cons 1
                    [color=blue](vla-get-EffectiveName
                          (vlax-ename->vla-object (ssname #Ent 0)))[/color])
            ) ;_ list
   ) ;_ entmake
 ) ;_ and
 (princ)
)

Lee Mac · 发表于 2022-7-6 08:34:00

这是另一个版本，经过调整以用于动态块和所有UCS/视图：

copy

(defun c:bn ( / e p ) (vl-load-com)
   (if
       (and
           (setq e (ssget "_+.:E:S" '((0 . "INSERT"))))
           (setq e (vlax-ename->vla-object (ssname e 0)))
           (setq p (getpoint "\nSpecify Point for MText: "))
       )
       (entmake
           (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
               (cons 7 (getvar 'TEXTSTYLE))
               (cons 10 (trans p 1 0))
               (cons 11 (getvar 'UCSXDIR))
               (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
               (cons 1
                   (vlax-get-property e
                       (if (vlax-property-available-p e 'effectivename)
                           'effectivename
                           'name
                       )
                   )
               )
           )
       )
   )
   (princ)
)

编辑：哎呀！pBe打败了我

pBe · 发表于 2022-7-6 08:42:11

不错的添加

但这种情况并不经常发生

干杯，李

Lee Mac · 发表于 2022-7-6 08:47:42

尝试以下操作（通过视口使用）：

copy

(defun c:bn ( / e p ) (vl-load-com)
   (if
       (and
           (setq e (ssget "_+.:E:S" '((0 . "INSERT"))))
           (setq e (vlax-ename->vla-object (ssname e 0)))
           (setq p (getpoint "\nSpecify Point for MText: "))
       )
       (entmake
           (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
               (cons   7 (getvar 'TEXTSTYLE))
               (cons  10 (trans (trans p 1 2) 2 3))
               (cons  11 (getvar 'UCSXDIR))
               (cons  50 (getvar 'VIEWTWIST))
               (cons 410 (getvar 'CTAB))
               (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
               (cons 1
                   (vlax-get-property e
                       (if (vlax-property-available-p e 'effectivename)
                           'effectivename
                           'name
                       )
                   )
               )
           )
       )
   )
   (princ)
)

编辑：更新为ViewTwist帐户

pBe · 发表于 2022-7-6 08:55:42

现在我明白了，这就是他所说的纸面空间。

[编程交流] Lisp请求-单击块

发表回复

精选推荐