编程申请：以组合图元中心旋转并缩放

半听可乐

kwok 发表于 2013-1-6 22:45
cad要装有ET,试试

又要装个插件啊~~~是不是完整版的CAD2004有et工具？

kwok

半听可乐 发表于 2013-1-6 22:59
又要装个插件啊~~~是不是完整版的CAD2004有et工具？

一般的cad都有ET这个工具的,你装的时候自定义装就可选上自动装上了,如果没有装到也可以加装上的,.

bai2000

能改一下，能统计出各种图元的数量并写道图中更好

xyp1964

crazylsp

楼主这和普通的缩放有什么区别吗？

半听可乐

Gu_xl 发表于 2013-1-6 16:22
单个组合中心缩放旋转很容易，若要是批量执行，恐怕比较难，难点在程序如何在你选择的一堆图元里自动实现分 ...

G版，能不能帮我写个不需要装et工具箱就能用的程序？

crazylsp

能否先按普通命令旋转缩放后，再计算插入点或文本中心点偏离原来的值返回去。

hao3ren

看了院长的程序，胡乱拼凑了一个程序，不要钱不要钱

2. (vl-load-com)
   
3. (defun c:ttaa ()
   
4.     (setq xx (getreal "\n 请输入横向范围<5000>"))
   
5.     (if (not xx) (setq xx 5000))
   
6.     (setq yy (getreal "\n 请输入纵向范围<5000>"))
   
7.     (if (not yy) (setq yy 5000))
   
8.     (setq jd (getreal "\n 请输入旋转角度<-47.7>"))
   
9.     (if (not jd) (setq jd -47.7))
   
10.     (setq bl (getreal "\n 请输入缩放比例<0.41667>"))
    
11.     (if (not bl) (setq bl 0.41667))
    
12.     (setq i -1)
    
13.   (if (setq ss (ssget '((0 . "text"))))
    
14.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
15.       (setq ssbox (GetSSBoundingbox s1))
    
16.       (setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))
    
17.       (setq pt2 (list (- (car midpt) xx) (- (cadr midpt) yy) 0.0))
    
18.       (setq pt3 (list (+ (car midpt) xx) (+ (cadr midpt) yy) 0.0))
    
19.       (if (setq ss1 (ssget "w" pt2 pt3))
    
20.   (progn
    
21.     (setq  ss1 (ssadd s1 ss1))
    
22.           (setq ssbox1 (GetSSBoundingbox ss1))
    
23.           (setq midpt1 (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox1) (cadr ssbox1)))  
    
24.     (command ".rotate" ss1 "" midpt1 jd)
    
25.     (command ".Scale" "P" "" midpt1 bl)
    
26.   )
    
27.       )
    
28.     )
    
29.   )
    
30. )
    
31. 
    
32. (defun GetSSBoundingbox (sse / ss i ssn ll rr box ptlist ssbox)
    
33.   (if (= 'ENAME (type sse))
    
34.     (progn (setq ss (ssadd)) (ssadd sse ss))
    
35.     (setq ss sse))
    
36.   (if ss
    
37.     (progn
    
38.       (setq i -1)
    
39.       (repeat (sslength ss)
    
40.         (setq ssn (ssname ss (setq i (1+ i))))
    
41.         (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒
    
42.         (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))
    
43.         (setq ptlist (append ptlist box))
    
44.         )
    
45.       (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))
    
46.       )
    
47.     )
    
48.   )
    

(vl-load-com)<br /> (defun c:ttaa ()<br />     (setq xx (getreal "\n 请输入横向范围<5000>"))<br />     (if (not xx) (setq xx 5000))<br />     (setq yy (getreal "\n 请输入纵向范围<5000>"))<br />     (if (not yy) (setq yy 5000))<br />     (setq jd (getreal "\n 请输入旋转角度<-47.7>"))<br />     (if (not jd) (setq jd -47.7))<br />     (setq bl (getreal "\n 请输入缩放比例<0.41667>"))<br />     (if (not bl) (setq bl 0.41667))<br />     (setq i -1)<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (setq ssbox (GetSSBoundingbox s1))<br />       (setq midpt (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox) (cadr ssbox)))<br />       (setq pt2 (list (- (car midpt) xx) (- (cadr midpt) yy) 0.0))<br />       (setq pt3 (list (+ (car midpt) xx) (+ (cadr midpt) yy) 0.0))<br />       (if (setq ss1 (ssget "w" pt2 pt3))<br />   (progn<br />     (setq  ss1 (ssadd s1 ss1))<br />           (setq ssbox1 (GetSSBoundingbox ss1))<br />           (setq midpt1 (mapcar '(lambda (a b) (/ (+ a b) 2)) (car ssbox1) (cadr ssbox1)))  <br />     (command ".rotate" ss1 "" midpt1 jd)<br />     (command ".Scale" "P" "" midpt1 bl)<br />   )<br />       )<br />     )<br />   )<br /> )<br /> <br /> (defun GetSSBoundingbox (sse / ss i ssn ll rr box ptlist ssbox)<br />   (if (= 'ENAME (type sse))<br />     (progn (setq ss (ssadd)) (ssadd sse ss))<br />     (setq ss sse))<br />   (if ss<br />     (progn<br />       (setq i -1)<br />       (repeat (sslength ss)<br />         (setq ssn (ssname ss (setq i (1+ i))))<br />         (vla-GetBoundingBox (vlax-ename->vla-object ssn) 'll 'rr)  ;得到对象的包围盒<br />         (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr)))<br />         (setq ptlist (append ptlist box))<br />         )<br />       (setq ssbox (mapcar '(lambda (x) (apply 'mapcar (cons x ptlist))) (list 'min 'max)))<br />       )<br />     )<br />   )<br />

依然小小鸟

发现楼主的需求大部分是我想要的

664571221

太厉害了真的不错