请求高手帮忙写一个图块批量放大程序，谢谢！

lingduwx

偶想要的操作步骤：假设“图块放大命令为bf”
1、输入bf，回车,提示选择图块(若不选择图块则直接回车),选择(可以框选)图块 A和B     ,(主要是选择作为参考，同一图块可以选择多个),回车。
2、提示选择区域(若第一步没有选择图块的话，则默认选择区域内的所有图块)，若第一步选择了图块的话，则区域内的其它图块或则物体都不会被选择。
3、回车确定选择图块后，提示输入缩放比例，输入之后回车，OK.
特别要求：1、要支持动态块、无名块、属性块（支持属性块的文字同时进行缩放）
                  2、图块基点不变

下面是测试CAD文件，2004格式


望高手帮忙啊！！！

Andyhon

Ok here

Gu_xl

选择图块原位比例缩放：

1. (defun c:tt (/ scale ss n obj)
   
2.   (while (setq ss (ssget ":L" '((0 . "insert"))))
   
3.     (if (null *scale)
   
4.       (setq *scale 2.0)
   
5.       )
   
6.     (initget 6)
   
7.     (setq scale (getreal (strcat "\n缩放比例<" (rtos *scale 2 2) ">:")))
   
8.     (if (null scale)
   
9.       (setq scale *scale)
   
10.       (setq *scale scale)
    
11.       )
    
12.     (repeat (setq n (sslength ss))
    
13.       (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
    
14.       (vla-ScaleEntity obj (vla-get-InsertionPoint obj) scale)
    
15.       )
    
16.     )
    
17.   (princ)
    
18.   )

(defun c:tt (/ scale ss n obj)<br />   (while (setq ss (ssget ":L" '((0 . "insert"))))<br />     (if (null *scale)<br />       (setq *scale 2.0)<br />       )<br />     (initget 6)<br />     (setq scale (getreal (strcat "\n缩放比例<" (rtos *scale 2 2) ">:")))<br />     (if (null scale)<br />       (setq scale *scale)<br />       (setq *scale scale)<br />       )<br />     (repeat (setq n (sslength ss))<br />       (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))<br />       (vla-ScaleEntity obj (vla-get-InsertionPoint obj) scale)<br />       )<br />     )<br />   (princ)<br />   )

lingduwx

Gu_xl 发表于 2013-3-7 12:40
选择图块原位比例缩放：

谢谢G版的热心关注，偶先试用了一下，非常好，不过要是能实现以下功能就好了。
假若一个图里面有很多不同的图块，我只想缩放选择区域内的图块A，或者图块A、图块B一起缩放,或者图块A、图块B、图块C或者更多，主要是经常在一个区域内有不同的图块，只想缩放其中的某几种图块，要是能实现这个功能就更好了

Gu_xl

lingduwx 发表于 2013-3-7 15:38
谢谢G版的热心关注，偶先试用了一下，非常好，不过要是能实现以下功能就好了。
假若一个图里面有很多不同 ...

修改这句即可：
(setq ss (ssget ":L" '((0 . "insert"))))

==》
(setq ss (ssget ":L" '((0 . "insert")(2 . "A,B"))))

lingduwx

谢谢版主，图块A和图块B或者还有图块c只是我举的一个例子，实际应用中可能是其它不同的图块名字

lingduwx

Gu_xl 发表于 2013-3-7 16:26
修改这句即可：
(setq ss (ssget ":L" '((0 . "insert"))))

谢谢版主，图块A和图块B或者还有图块c只是我举的一个例子，实际应用中可能是其它不同的图块名字
偶收藏的一个“多块同时缩放的LSP”,不知道是哪位高手写的，他的第一步就是要求输入图块名字，如果不输入的话，则默认所有图块，这个工具有两点不能满足我的要求：1、输入图块名字要是改为直接在图形中选择图块就好了。2、就是不支持属性块中的文字缩放。
      现在偶提供源码如下（主要是偶不懂改LSP）
;****************************************************
;                    bsc--多块同时缩放.lsp
;                    
;*****************************************************

;****************************************************多块同时缩放
(defun c:bsc ()
  (command "_.undo" "_begin")
  (setq        old_err        *error*
        *error*        Sb_err
  )
  (setq blkname (getstring "\n请输入需缩放的块名称:"))
  (initget 7)
  (setq blkfactor (getreal "\n请输入缩放倍数:"))
  (setq blksset (ssget (list (cons 0 "INSERT") (cons 2 blkname))))
  (setq blksscnt (sslength blksset))
  (setq donecount 0)
  (while (> blksscnt 0)
    (setq temp (ssname blksset (setq blksscnt (1- blksscnt))))
    (setq templist (entget temp))
    (setq blkbasept (cdr (assoc 10 templist)))
    (command "scale" temp "" blkbasept blkfactor ^c)
    (setq donecount (1+ donecount))
  )
  (princ (strcat "\n完成缩放 "
                 (itoa donecount)
                 " 个名称为"
                 "\""
                 blkname
                 "\""
                 "的块."
         )
  )
  (command "_.undo" "_end")
)

(defun Bs_err (s)
  (princ "\n命令中止!")
  (setq *error* old_err)
  (princ)
)

(princ)

零开始

试试这样的。

ZZXXQQ

1. ;****************************************************
   
2. ;                bsc--多块同时缩放.lsp
   
3. ;****************************************************
   
4. (defun c:bsc ()
   
5. (command "_.undo" "_begin")
   
6. (setq old_err *error* *error* Sb_err)
   
7. (if (and (princ "\n请选择需缩放的块:")
   
8.           (setq ss (ssget '((0 . "INSERT"))))) (progn
   
9.   (setq i 0 bnm (cdr(assoc 2 (entget(ssname ss 0)))))
   
10.   (repeat (1- (sslength ss))
    
11.    (setq ent (entget(ssname ss (setq i (1+ i))))
    
12.          bnm (strcat bnm "," (cdr(assoc 2 ent))))
    
13.   )
    
14.   (initget 7)
    
15.   (setq blkfactor (getreal "\n请输入缩放倍数:"))
    
16.   (setq blksset (ssget (list (cons 0 "INSERT") (cons 2 bnm))))
    
17.   (setq donecount 0)
    
18.   (repeat (sslength blksset)
    
19.    (setq temp (ssname blksset donecount))
    
20.    (setq templist (entget temp))
    
21.    (setq blkbasept (cdr (assoc 10 templist)))
    
22.    (command "scale" temp "" blkbasept blkfactor ^c)
    
23.    (setq donecount (1+ donecount))
    
24.   )
    
25.   (princ (strcat "\n完成缩放 " (itoa donecount)
    
26.                  " 个名称为\"" blkname "\"的块."))
    
27. ))
    
28. (command "_.undo" "_end")
    
29. (princ)
    
30. )
    
31. (defun Bs_err (s)
    
32. (princ "\n命令中止!")
    
33. (setq *error* old_err)
    
34. (princ)
    
35. )
    
36. (princ)
    

;****************************************************<br /> ;                bsc--多块同时缩放.lsp<br /> ;****************************************************<br /> (defun c:bsc ()<br /> (command "_.undo" "_begin")<br /> (setq old_err *error* *error* Sb_err)<br /> (if (and (princ "\n请选择需缩放的块:")<br />           (setq ss (ssget '((0 . "INSERT"))))) (progn<br />   (setq i 0 bnm (cdr(assoc 2 (entget(ssname ss 0)))))<br />   (repeat (1- (sslength ss))<br />    (setq ent (entget(ssname ss (setq i (1+ i))))<br />          bnm (strcat bnm "," (cdr(assoc 2 ent))))<br />   )<br />   (initget 7)<br />   (setq blkfactor (getreal "\n请输入缩放倍数:"))<br />   (setq blksset (ssget (list (cons 0 "INSERT") (cons 2 bnm))))<br />   (setq donecount 0)<br />   (repeat (sslength blksset)<br />    (setq temp (ssname blksset donecount))<br />    (setq templist (entget temp))<br />    (setq blkbasept (cdr (assoc 10 templist)))<br />    (command "scale" temp "" blkbasept blkfactor ^c)<br />    (setq donecount (1+ donecount))<br />   )<br />   (princ (strcat "\n完成缩放 " (itoa donecount)<br />                  " 个名称为\"" blkname "\"的块."))<br /> ))<br /> (command "_.undo" "_end")<br /> (princ)<br /> )<br /> (defun Bs_err (s)<br /> (princ "\n命令中止!")<br /> (setq *error* old_err)<br /> (princ)<br /> )<br /> (princ)<br />

lingduwx

ZZXXQQ 发表于 2013-3-8 08:36

谢谢版主，但是不知道为什么，我加载之后输入bsc后，提示未知命令