刷块比例及修改比例源码（均以基点缩放）

ㄘ丶转裑ㄧ灬

最近论坛比较平静，发一个大家可能用得上的程序，活跃活跃。。
下面的第一个刷块比例没用组码修改，因为如果是属性块的话，用组码改变不了大小，所以用了缩放（第二个程序也一样），
这个问题困扰了我很久，今天不经意间看到了xyp1964和ZZXXQQ两位老师的程序，才发现可以换一种思路。。
属于按自己理解拼凑的刷块比例，如果有不规范的地方或者有更简洁的方式，望大家指正！
（我属于在论坛淘宝的，没学lisp）

希望大家可以帮我优化一个小地方，即可以先选择图块再输入命令，不用再选择一次。（两个程序都有这问题）
当然，不好优化的话也没关系，不算大问题。

1. ;; ;;;;;;;;;;刷块比例 - 转身-2016.05.26
   
2. ;; 参考：xyp1964-刷块角度：http://bbs.mjtd.com/forum.php?mo ... mp;page=2#pid478664
   
3. ;; 参考：ZZXXQQ-图块基点放大：http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid369374
   
4. ;; 属本人拼凑（没LISP基础,不明白if、progn的用法），感谢院长的通用函数！
   
5. ;; 若有不合逻辑和编程规范之处，敬请指正！
   
6. (defun c:FA ()
   
7.   (if (and (setq s1 (car (entsel "\n>>>>>>>>选择源样块: ")))
   
8.     (= (xyp-get-dxf 0 s1) "INSERT")
   
9.       )
   
10.     (progn
    
11.       (princ "\n>>>>>>>>选择要修改的图块:>>>>>>>>> ")
    
12.       (setvar "cmdecho" 0)
    
13.       (command ".undo" "be")
    
14.     (if (setq ss (ssget '((0 . "INSERT"))))
    
15.       (progn
    
16.         (setq i 0)
    
17.         (repeat (sslength ss)
    
18.           (setq en (ssname ss i)
    
19.               ent (entget en)
    
20.               i (1+ i)
    
21.               pc (cdr(assoc 10 ent)))
    
22.           (setq rad1 (xyp-get-dxf 41 s1)
    
23.               rad2 (xyp-get-dxf 41 en)
    
24.               rad3 (sqrt (* rad1 rad1))
    
25.               rad4 (sqrt (* rad2 rad2)));;开根，把负值变为正值;;或取值时用Z值
    
26.           (setq sc (/ rad3 rad4 ))
    
27.     (command ".scale" en "" pc sc)
    
28.         )   
    
29.       )
    
30.     )
    
31.     )
    
32.   )
    
33.    (command ".undo" "e")
    
34. (setvar "cmdecho" 1)
    
35.   (princ)
    
36. )
    
37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;修改块比例（省得输三次数值）
    
38. (defun c:FB ()
    
39. (setvar "CMDECHO" 0)
    
40. (command ".UNDO" "BE")
    
41. (if (setq ss (ssget '((0 . "INSERT"))))
    
42. (progn
    
43.   (setq sI (getdist "\n>>>>>>>>>输入新的比例值:"))
    
44.   (setq i 0)
    
45.   (repeat (sslength ss)
    
46.    (setq en (ssname ss i)
    
47.          ent (entget en)
    
48.          i (1+ i)
    
49.          pc (cdr(assoc 10 ent)))
    
50.   (setq rad-1 (xyp-get-dxf 41 en)
    
51.      rad-2 (sqrt (* rad-1 rad-1)));;开根，把负值变为正值;;或取值时用Z值
    
52.   (setq sc (/ SI rad-2 ))
    
53.    (command ".scale" en "" pc sc)
    
54.   )
    
55. ))
    
56. (command ".UNDO" "E")
    
57. (setvar "CMDECHO" 1)
    
58. (princ)
    
59. )
    
60. ;; xyp-get-DXF 实体dxf数据 (xyp-get-DXF code ename)
    
61. (defun xyp-get-DXF (code ename / ent lst a)
    
62.   (if (= (type code) 'LIST)
    
63.     (progn
    
64.       (setq ent        (entget ename)
    
65.             lst        '()
    
66.       )
    
67.       (foreach a code
    
68.         (setq lst (cons (list a (cdr (assoc a ent))) lst))
    
69.       )
    
70.       (reverse lst)
    
71.     )
    
72.     (if        (= code -3)
    
73.       (cdr (assoc code (entget ename '("*"))))
    
74.       (cdr (assoc code (entget ename)))
    
75.     )
    
76.   )
    
77. )

;; ;;;;;;;;;;刷块比例 - 转身-2016.05.26<br /> ;; 参考：xyp1964-刷块角度：<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79636&page=2#pid478664" target="_blank">http://bbs.mjtd.com/forum.php?mo ... mp;page=2#pid478664</a><br /> ;; 参考：ZZXXQQ-图块基点放大：<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69984&page=1#pid369374" target="_blank">http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid369374</a><br /> ;; 属本人拼凑（没LISP基础,不明白if、progn的用法），感谢院长的通用函数！<br /> ;; 若有不合逻辑和编程规范之处，敬请指正！<br /> (defun c:FA ()<br />   (if (and (setq s1 (car (entsel "\n>>>>>>>>选择源样块: ")))<br />     (= (xyp-get-dxf 0 s1) "INSERT")<br />       )<br />     (progn<br />       (princ "\n>>>>>>>>选择要修改的图块:>>>>>>>>> ")<br />       (setvar "cmdecho" 0)<br />       (command ".undo" "be")<br />     (if (setq ss (ssget '((0 . "INSERT")))) <br />       (progn<br />         (setq i 0)<br />         (repeat (sslength ss)<br />           (setq en (ssname ss i)<br />               ent (entget en)<br />               i (1+ i)<br />               pc (cdr(assoc 10 ent)))<br />           (setq rad1 (xyp-get-dxf 41 s1)<br />               rad2 (xyp-get-dxf 41 en)<br />               rad3 (sqrt (* rad1 rad1))<br />               rad4 (sqrt (* rad2 rad2)));;开根，把负值变为正值;;或取值时用Z值<br />           (setq sc (/ rad3 rad4 ))<br />     (command ".scale" en "" pc sc)<br />         )    <br />       )<br />     )<br />     )<br />   )<br />    (command ".undo" "e")<br /> (setvar "cmdecho" 1)<br />   (princ)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;修改块比例（省得输三次数值）<br /> (defun c:FB ()<br /> (setvar "CMDECHO" 0)<br /> (command ".UNDO" "BE")<br /> (if (setq ss (ssget '((0 . "INSERT")))) <br /> (progn<br />   (setq sI (getdist "\n>>>>>>>>>输入新的比例值:"))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />    (setq en (ssname ss i)<br />          ent (entget en)<br />          i (1+ i)<br />          pc (cdr(assoc 10 ent)))<br />   (setq rad-1 (xyp-get-dxf 41 en)<br />      rad-2 (sqrt (* rad-1 rad-1)));;开根，把负值变为正值;;或取值时用Z值<br />   (setq sc (/ SI rad-2 ))<br />    (command ".scale" en "" pc sc)<br />   )<br /> ))<br /> (command ".UNDO" "E")<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br /> ;; xyp-get-DXF 实体dxf数据 (xyp-get-DXF code ename)<br /> (defun xyp-get-DXF (code ename / ent lst a)<br />   (if (= (type code) 'LIST)<br />     (progn<br />       (setq ent        (entget ename)<br />             lst        '()<br />       )<br />       (foreach a code<br />         (setq lst (cons (list a (cdr (assoc a ent))) lst))<br />       )<br />       (reverse lst)<br />     )<br />     (if        (= code -3)<br />       (cdr (assoc code (entget ename '("*"))))<br />       (cdr (assoc code (entget ename)))<br />     )<br />   )<br /> )

香远益清

程序使用很好，只是提示字符为乱码：命令: fa
>>>>>>>>閫夋嫨婧愭牱鍧
我只好将汉字改为拼音字母，哪位高人指点一下，我经常遇到这种现象。自编的程序段也是，只要出现getstring等函数时，汉字提示就显示乱码，只好改为拼音了。

香远益清

正需要呢，省得编写了，其中的FB命令一段正需要，各个块的基点不变，批量缩放块

依然小小鸟

不错的帖子 顶一下

dingtiedt

没学lisp，都写得这么好啊

1993063

还是利用改组码方式修改的?来自: Android客户端

ㄘ丶转裑ㄧ灬

1993063 发表于 2016-5-27 00:35
还是利用改组码方式修改的?

只是取组码值用于计算比例因子，然后都是以基点进行缩放

1993063

2. (defun c:tt ( / s sc )
   
3.   (setq sc
   
4.     (cond
   
5.       ((getreal "\n块比例<点块获比例>"))
   
6.       ((vla-get-xscalefactor (vlax-ename->vla-object (car (entsel)))))
   
7.     )
   
8.   )
   
9.   (if (ssget)
   
10.     (vlax-for s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
    
11.       (vla-put-xscalefactor s sc)
    
12.       (vla-put-yscalefactor s sc)
    
13.     )
    
14.   )
    
15. )

(defun c:tt ( / s sc ) <br />   (setq sc<br />     (cond<br />       ((getreal "\n块比例<点块获比例>"))<br />       ((vla-get-xscalefactor (vlax-ename->vla-object (car (entsel)))))<br />     )<br />   )<br />   (if (ssget)<br />     (vlax-for s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))<br />       (vla-put-xscalefactor s sc)<br />       (vla-put-yscalefactor s sc)<br />     )<br />   )<br /> )

ㄘ丶转裑ㄧ灬

1993063 发表于 2016-5-27 19:23

只能说一个字：牛！
但是有一个问题：假设块是镜像过的，比例值是负值，那么刷比例或改比例就会变回正值，变成没镜像的了，而且属性文字会跑偏。

1993063

你测试过比例值是负值,刷完后变成正值?[em0]

ㄘ丶转裑ㄧ灬

1993063 发表于 2016-5-28 08:10
你测试过比例值是负值,刷完后变成正值?

演示是用了属性块图框，一般不会有镜像的，只是演示用。。
刷块和改比例都会变为正值，所以对于其它图块就不具有通用性了。。
而且好像撤销一次会多撤销一步。。

我以为可能是局部变量的问题，所以又把变量名改了，还是一样。。

感谢老师用vlisp写了这么简洁的代码，这个函数确实强大，有时间了我再查查帮助文件！

附上测试文件：

彳余

确实强大，确实强大

my258

很强大