如何更改所有块的比例

chico1201 · 发表于 2022-7-5 20:29:33

我发现了一个lisp，但它不能在新版本的ACAD2015中使用，但可以在ACAD2012中使用。
请有任何人可以帮我尝试更新这个Lisp程序？还是给我另一个选择？
谢谢！！

（定义C:CBS（）
（setq p（ssget））
（setq n（sslength p））
（setq k 0）
（while（=“”（setq bkn（strcase（getstring“Block name：”））））
（setq tr（tblsearch“BLOCK”bkn））
（while（null tr）
（提示（strcat“找不到块”bkn“））
（while（=“”（setq bkn（getstring“输入另一个块：”）））
（setq tr（tblsearch“BLOCK”bkn））
)

（如果（和（等于efg 1）(
（setq nsz（getreal“输入新比例：”））
)
（虽然(
（if（and（=“INSERT”（cdr（assoc 0（setq ent（entget（ssname p k 107;）а）））））（=bkn（cdr（assoc 2 ent）））
（程序
（setq e41（assoc 41 ent））
（setq e42（assoc 42 ent））
（setq e43（assoc 43 ent））
（setq ent（subst（cons 41 nsz）e41 ent））
（setq ent（subst（cons 42 nsz）e42 ent））
（setq ent（subst（cons 43 nsz）e43 ent））
（entmod ent）
))
（设定值k（+1 k））
))

Tharwat · 发表于 2022-7-5 20:39:31

欢迎来到CADTutor。

首先修改你的帖子，将标签代码包含在你的日常生活中。阅读本文。

这就是你想要的吗？

copy


(defun c:Test (/ s c i n e d)
 ;;        Tharwat 11.Dec.2014        ;;
 (if
   (and
     (setq s (ssget "_X" '((0 . "INSERT"))))
     (setq
       c (getdist "\n Specify New scale for ALL blocks to re-scale :"
         )
     )
   )
    (vlax-for x (setq
                  d (vla-get-ActiveSelectionSet
                      (vla-get-ActiveDocument (vlax-get-acad-object))
                    )
                )
      (if (vlax-write-enabled-p x)
        (mapcar '(lambda (v)
                   (vla-put-XScaleFactor x v)
                   (vla-put-YScaleFactor x v)
                   (vla-put-ZScaleFactor x v)
                 )
                (list c)
        )
      )
    )
    (if (not s)
      (alert "No Blocks found in this drawing !!")
    )
 )
 (if d
   (vla-delete d)
 )
 (princ)
)(vl-load-com)

chico1201 · 发表于 2022-7-5 20:48:16

谢谢Tharwat

我是否只能选择相同的块重新缩放。

Lee Mac · 发表于 2022-7-5 20:50:32

快速书写：

copy

(defun c:bscl ( / enx idx scl sel )
   (initget 6)
   (if (and (setq scl (getdist "\nSpecify scale factor: "))
            (setq sel (ssget "_:L" '((0 . "INSERT"))))
       )
       (repeat (setq idx (sslength sel))
           (setq enx (entget (ssname sel (setq idx (1- idx)))))
           (foreach dxf '(41 42 43)
               (setq enx (subst (cons dxf scl) (assoc dxf enx) enx))
           )
           (entmod enx)
       )
   )
   (princ)
)

chico1201 · 发表于 2022-7-5 20:58:48

谢谢你，李
太完美了。

Tharwat · 发表于 2022-7-5 21:05:15

你帖子的标题说明了一切，这就是我为什么这么做的原因，无论如何，这里有一些修改，以适应你的新要求。

copy


(defun c:Test (/ s c i n e d)
 ;;        Tharwat 11.Dec.2014        ;;
 (if
   (and
     (setq s (ssget "_:L" '((0 . "INSERT"))))
     (setq
       c (getdist "\n Specify New scale for ALL blocks to re-scale :"
         )
     )
   )
    (vlax-for x (setq
                  d (vla-get-ActiveSelectionSet
                      (vla-get-ActiveDocument (vlax-get-acad-object))
                    )
                )
      (mapcar '(lambda (v)
                 (vla-put-XScaleFactor x v)
                 (vla-put-YScaleFactor x v)
                 (vla-put-ZScaleFactor x v)
               )
              (list c)
      )
    )
    (if (not s)
      (alert "No Blocks found in this drawing !!")
    )
 )
 (if d
   (vla-delete d)
 )
 (princ)
)(vl-load-com)