The Courage Dog 发表于 2022-7-6 10:35:01

全局更改文本h的列表

您好,是否有任何人拥有lisp例程,可以全局更改块中文本、多行文字和属性的高度和宽度因子:(。非常感谢您的帮助。
 
谢谢
勇气犬

Lee Mac 发表于 2022-7-6 10:45:31

这是一种在块定义和现有插入中更改它的粗略方法。
 
但要小心预格式化的多行文字。
 

(defun c:Redefine_Block_Text (/ *error* itemp GetName ENT OBJ UFLAG)
(vl-load-com)
;; Lee Mac~11.03.10

(defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

(defun itemp (collection item / result)
   (if (not (vl-catch-all-error-p
            (setq result (vl-catch-all-apply (function vla-item)
                           (list collection item)))))
       result))

(setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

(setq GetName (lambda (obj) (if (vlax-property-available-p obj 'EffectiveName)
                               (vla-get-EffectiveName obj)
                               (vla-get-Name obj))))

(or *hdef* (setq *hdef* 1.0))
(or *twid* (setq *twid* 1.0))

(while
   (progn
   (setq ent (car (entsel "\nSelect Block to Change: ")))

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

            (if (eq "AcDbBlockReference"
                      (vla-get-Objectname
                        (setq obj (vlax-ename->vla-object ent))))
                (progn
                  (setq uFlag (not (vla-StartUndoMark *doc)))

                  (initget 6)
                  (setq *hdef* (cond ((getdist "\nSpecify New Text Height: "))   (*hdef*)))
                  
                  (initget 6)
                  (setq *twid* (cond ((getdist "\nSpecify Text Width Factor: ")) (*twid*)))

                  (if (ssget "_X" (list (cons 0 "INSERT") (cons 2 (GetName obj)) (cons 66 1)))
                  (progn
                      (vlax-for sObj (setq ss (vla-get-ActiveSelectionSet *doc))
                        
                        (foreach att (append (vlax-invoke sObj 'GetAttributes)
                                             (vlax-invoke sObj 'GetConstantAttributes))

                        (vla-put-Height att *hdef*)

                        (if (eq :vlax-false (vla-get-MTextAttribute att))
                            (vla-put-ScaleFactor att *twid*)
                            (vla-put-TextString att (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                            (vla-get-TextString att) "}")))))
                      (vla-delete ss)))

                  (vlax-for sub (itemp (vla-get-Blocks *doc) (GetName obj))

                  (cond ((vl-position (vla-get-ObjectName sub) '("AcDbText" "AcDbAttributeDefinition"))

                           (vla-put-Height sub *hdef*)
                           (vla-put-ScaleFactor sub *twid*))

                        ((eq "AcDbMText" (vla-get-ObjectName sub))

                           (vla-put-Height sub *hdef*)
                           (vla-put-TextString sub (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                             (vla-get-TextString sub) "}")))))

                  (setq uFlag (vla-EndUndomark *doc))
                  (vla-Regen *doc AcActiveViewport))

                (princ "\n** Object Must be a Block **"))))))
(princ))      

gilsoto13 发表于 2022-7-6 10:48:28

 
尚未测试。。。但这一定是另一个伟大的惯例。。。你怎么能这么快?
 
我无法想象你的大脑处于顶端。。。数字和漂浮在周围的东西。。。我是我办公室的autocad解决方案负责人,我用过你的一些Lisp。。。我必须考虑开始付款
 
但是,我甚至还没有创建我的paypal帐户。。。我想当我决定开始使用paypal时,我会付钱的。。。。

Lee Mac 发表于 2022-7-6 10:53:18

 
它就像我打字一样快。。。我确切地知道我想要使用的过程,以及使用什么等。我使用一些代码块,如错误处理程序,以避免反复键入它。。。但实际上这只是练习。
 
我的Lisp程序没有付款要求。。。我写它们是为了消遣(和这里的大多数成员一样),但当然,我们都很乐意接受捐款

alanjt 发表于 2022-7-6 11:03:39

 
向论坛捐款。没有它,这一切都不可能。

geonor 发表于 2022-7-6 11:08:11

李,你好,
是否有可能在选定数量的块上执行此操作?如果是的话,那太好了,因为这就是我一直在寻找的!
 
谢谢
geonor公司

Lee Mac 发表于 2022-7-6 11:12:38

我已经有一段时间没有看了,但我知道当前代码将改变所选块的所有引用-您是否希望选择多个不同的块?

geonor 发表于 2022-7-6 11:18:27

谢谢你的回复。
问题是,数据已从GIS导出到DXF。块的名称基于GIS中的对象类别和对象的唯一句柄。这意味着,有相同类型的区块(例如下水道人孔),但区块名称不同。这就像有1000份相同引用的副本(每个副本有不同的块/引用名称)。对于所有这些,我想更改所有包含文本的宽度/高度。所以我一直在研究的是一个过程,它允许修改一个块中的所有文本,以获得多个选定的块。

Lee Mac 发表于 2022-7-6 11:24:52

嗨,试试这个:
 

(defun c:RedefineBlockText ( / *error* doc blocks GetName ss undo )
(vl-load-com)
;; © Lee Mac 2010

(defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
)

(setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
       blocks (vla-get-Blocks doc))

(setq GetName
   (lambda ( obj )
   (if (vlax-property-available-p obj 'EffectiveName)
       (vla-get-EffectiveName obj)
       (vla-get-Name obj)
   )
   )
)

(mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) '(*hdef* *twid*) '(1. 1.))

(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (
   (lambda ( i / e o n done atts sub )
       (initget 6)
       (setq *hdef* (cond ( (getdist "\nSpecify New Text Height: ") ) ( *hdef* )))
      
       (initget 6)
       (setq *twid* (cond ( (getdist "\nSpecify Text Width Factor: ") ) ( *twid* )))
      
       (setq undo (not (vla-StartUndoMark doc)))
      
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq o (vlax-ename->vla-object e))

         (if (not (vl-position (setq n (GetName o)) done))
         (progn

             (if (setq atts (ssget "_X" (list (cons 0 "INSERT") (cons 2 n) (cons 66 1))))
               (
               (lambda ( j / f p att )
                  
                   (while (setq f (ssname atts (setq j (1+ j))))
                     (setq p (vlax-ename->vla-object f))

                     (foreach att (append (vlax-invoke p 'GetAttributes)
                                          (vlax-invoke p 'GetConstantAttributes))
                     
                     (vla-put-Height att *hdef*)

                     (if (eq :vlax-false (vla-get-MTextAttribute att))
                         (vla-put-ScaleFactor att *twid*)
                         (vla-put-TextString att
                           (strcat "{\\W" (vl-princ-to-string *twid*) ";" (vla-get-TextString att) "}")
                         )
                     )
                     )
                   )
               )
               -1
               )
             )

             (vlax-for sub (LM:Itemp Blocks n)

               (cond
               ( (vl-position (vla-get-ObjectName sub) '("AcDbText" "AcDbAttributeDefinition"))
                  
                   (vla-put-Height sub *hdef*)
                   (vla-put-ScaleFactor sub *twid*)
               )
               ( (eq "AcDbMText" (vla-get-ObjectName sub))
                  
                   (vla-put-Height sub *hdef*)
                   (vla-put-TextString sub
                     (strcat "{\\W" (vl-princ-to-string *twid*) ";" (vla-get-TextString sub) "}")
                   )
               )
               )
             )
             (setq done (cons n done))
         )
         )
       )

       (setq undo (vla-EndUndoMark doc))
       (vla-Regen doc AcActiveViewport)
   )
   -1
   )
)

(princ)
)

;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;Retrieves the item with index 'item' if present in the    ;;
;;specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;Arguments:                                                ;;
;;coll - the VLA Collection Object                        ;;
;;item - the index of the item to be retrieved            ;;
;;------------------------------------------------------------;;
;;Returns:the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;

(defun LM:Itemp ( coll item )
;; © Lee Mac 2010
(if
   (not
   (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
         (function vla-item) (list coll item)
         )
       )
   )
   )
   item
)
)

geonor 发表于 2022-7-6 11:29:53

测试和享受,
这套程序非常有效,而且做得非常完美。
太棒了,非常感谢。。。
页: [1] 2
查看完整版本: 全局更改文本h的列表