社区 › Auto Lisp › Lisp请求-单击块

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

Lisp请求-单击块

是否有一个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

 
不知道你是什么意思那个爸爸
 
匿名名称友好
(defun c:BlockName (/ #Ent #Point)
(vl-load-com)      
(and
   (setq #Ent (ssget "_:S:E" '((0 . "INSERT"))))
    (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
                  (vla-get-EffectiveName
                        (vlax-ename->vla-object (ssname #Ent 0))))
            ) ;_ list
   ) ;_ entmake
) ;_ and
(princ)
)

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

这是另一个版本，经过调整以用于动态块和所有UCS/视图：
 
(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

尝试以下操作（通过视口使用）：
 
(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))
               (cons10 (trans (trans p 1 2) 2 3))
               (cons11 (getvar 'UCSXDIR))
               (cons50 (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请求-单击块