刷块比例及修改比例源码（均以基点缩放）
最近论坛比较平静，发一个大家可能用得上的程序，活跃活跃。。
下面的第一个刷块比例没用组码修改，因为如果是属性块的话，用组码改变不了大小，所以用了缩放（第二个程序也一样），
这个问题困扰了我很久，今天不经意间看到了xyp1964和ZZXXQQ两位老师的程序，才发现可以换一种思路。。
属于按自己理解拼凑的刷块比例，如果有不规范的地方或者有更简洁的方式，望大家指正！
（我属于在论坛淘宝的，没学lisp）
希望大家可以帮我优化一个小地方，即可以先选择图块再输入命令，不用再选择一次。（两个程序都有这问题）
当然，不好优化的话也没关系，不算大问题。
;; ;;;;;;;;;;刷块比例 - 转身-2016.05.26
;; 参考：xyp1964-刷块角度：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79636&page=2#pid478664
;; 参考：ZZXXQQ-图块基点放大：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69984&page=1#pid369374
;; 属本人拼凑（没LISP基础,不明白if、progn的用法），感谢院长的通用函数！
;; 若有不合逻辑和编程规范之处，敬请指正！
(defun c:FA ()
(if (and (setq s1 (car (entsel "\n>>>>>>>>选择源样块: ")))
(= (xyp-get-dxf 0 s1) "INSERT")
)
(progn
(princ "\n>>>>>>>>选择要修改的图块:>>>>>>>>> ")
(setvar "cmdecho" 0)
(command ".undo" "be")
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
i (1+ i)
pc (cdr(assoc 10 ent)))
(setq rad1 (xyp-get-dxf 41 s1)
rad2 (xyp-get-dxf 41 en)
rad3 (sqrt (* rad1 rad1))
rad4 (sqrt (* rad2 rad2)));;开根，把负值变为正值;;或取值时用Z值
(setq sc (/ rad3 rad4 ))
(command ".scale" en "" pc sc)
)
)
)
)
)
(command ".undo" "e")
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;修改块比例（省得输三次数值）
(defun c:FB ()
(setvar "CMDECHO" 0)
(command ".UNDO" "BE")
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq sI (getdist "\n>>>>>>>>>输入新的比例值:"))
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
i (1+ i)
pc (cdr(assoc 10 ent)))
(setq rad-1 (xyp-get-dxf 41 en)
rad-2 (sqrt (* rad-1 rad-1)));;开根，把负值变为正值;;或取值时用Z值
(setq sc (/ SI rad-2 ))
(command ".scale" en "" pc sc)
)
))
(command ".UNDO" "E")
(setvar "CMDECHO" 1)
(princ)
)
;; xyp-get-DXF 实体dxf数据 (xyp-get-DXF code ename)
(defun xyp-get-DXF (code ename / ent lst a)
(if (= (type code) 'LIST)
(progn
(setq ent (entget ename)
lst '()
)
(foreach a code
(setq lst (cons (list a (cdr (assoc a ent))) lst))
)
(reverse lst)
)
(if (= code -3)
(cdr (assoc code (entget ename '("*"))))
(cdr (assoc code (entget ename)))
)
)
)
程序使用很好，只是提示字符为乱码：命令: fa
>>>>>>>>閫夋嫨婧愭牱鍧
我只好将汉字改为拼音字母，哪位高人指点一下，我经常遇到这种现象。自编的程序段也是，只要出现getstring等函数时，汉字提示就显示乱码，只好改为拼音了。 正需要呢，省得编写了，其中的FB命令一段正需要，各个块的基点不变，批量缩放块 不错的帖子 顶一下 没学lisp，都写得这么好啊 还是利用改组码方式修改的? 1993063 发表于 2016-5-27 00:35 static/image/common/back.gif
还是利用改组码方式修改的?
只是取组码值用于计算比例因子，然后都是以基点进行缩放 本帖最后由 1993063 于 2016-5-27 01:29 编辑
(defun c:tt ( / s sc )
(setq sc
(cond
((getreal "\n块比例<点块获比例>"))
((vla-get-xscalefactor (vlax-ename->vla-object (car (entsel)))))
)
)
(if (ssget)
(vlax-for s (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
(vla-put-xscalefactor s sc)
(vla-put-yscalefactor s sc)
)
)
) 1993063 发表于 2016-5-27 19:23 static/image/common/back.gif
只能说一个字：牛！
但是有一个问题：假设块是镜像过的，比例值是负值，那么刷比例或改比例就会变回正值，变成没镜像的了，而且属性文字会跑偏。 你测试过比例值是负值,刷完后变成正值? 1993063 发表于 2016-5-28 08:10 static/image/common/back.gif
你测试过比例值是负值,刷完后变成正值?
演示是用了属性块图框，一般不会有镜像的，只是演示用。。
刷块和改比例都会变为正值，所以对于其它图块就不具有通用性了。。
而且好像撤销一次会多撤销一步。。
我以为可能是局部变量的问题，所以又把变量名改了，还是一样。。
感谢老师用vlisp写了这么简洁的代码，这个函数确实强大，有时间了我再查查帮助文件！
附上测试文件：
确实强大，确实强大 很强大
页:
[1]
2