全局更改文本h的列表

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

您好，是否有任何人拥有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

嗨，试试这个：

copy


(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

测试和享受，
这套程序非常有效，而且做得非常完美。
太棒了，非常感谢。。。

[编程交流] 全局更改文本h的列表

发表回复

精选推荐