社区 › Auto Lisp › 如何更改所有块的比例

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。
 
首先修改你的帖子，将标签代码包含在你的日常生活中。阅读本文。
 
这就是你想要的吗？
 

(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

快速书写：
(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

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

(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)

chico1201 发表于 2022-7-5 21:14:27

updn。dwgMABLK。rar公司

pmxcad 发表于 2022-7-5 21:17:01

也可以使用快速选择工具按名称或图层选择块，并在特性托盘中更改比例。
比例（x、y、z）必须相同，否则动态块不起作用。
 
PmxCAD

Lee Mac 发表于 2022-7-5 21:23:34

 
不客气！

SLW210 发表于 2022-7-5 21:29:45

请阅读代码发布指南并编辑您的帖子，将代码包含在代码标签中。

查看完整版本: 如何更改所有块的比例