如何原位缩放？？？？

依然小小鸟

由于经常需要处理地质勘查图，  地勘单位给的钻孔我需要拷到总图上面，但是往往拷过来之后 比例会不匹配  表现在钻孔特别大  我现在想批量把这些钻孔缩放  而且是原位缩放（因为钻孔的位置是死的 ）  求大神解决   最好是钻孔的文字编号也能一块和钻孔原位缩放  其中钻孔圆的直径由5  缩放为3 钻孔编号的字高由2变为1.5

依然小小鸟

http://bbs.mjtd.com/forum.php?mo ... hlight=%CB%F5%B7%C5
G版 之前有一个原位缩放的 程序  但是我用完后 发现不适用我这个   
求大神优化一下代码 让钻孔和钻孔的编号 均以钻孔的中心点  原位缩放

start4444

为什么你的标注都是散的，都搞成一个块，再用g版的程序就行了

依然小小鸟

start4444 发表于 2018-8-30 17:51
为什么你的标注都是散的，都搞成一个块，再用g版的程序就行了

那样太慢了 每个钻孔做成一个块 有这功夫 我还不如每个钻孔  用SC缩放

Andyhon

(defun C:try ()

   (command "Select"
     (ssget '((0 . "CIRCLE") (-4 . "<") (40 . 1.625)))
     "R"
     (ssget "P" '((0 . "CIRCLE") (-4 . "<") (40 . 1.)))
     ""
   )  
   
   (setq ss (ssget "P")
         HH '(12 6)
          i  -1
   )  
   
   (while (setq ee (ssname ss (setq i (1+ i))))
     (setq pt (dxg 10 ee)
          pt1 (mapcar '- pt HH)
          pt2 (mapcar '+ pt HH)
          ss1 (ssget "W" pt1 pt2)
     )
     (command "Scale" "W" (mapcar '- pt HH) (mapcar '+ pt HH) "" pt 0.25)
   )  

)

start4444

依然小小鸟 发表于 2018-8-30 20:58
那样太慢了 每个钻孔做成一个块 有这功夫 我还不如每个钻孔  用SC缩放

如果都是散的真的只能sc一个个来缩放，因为批量处理没法判断哪个单元属于同一个标注

smartstar

根据楼上大师的代码修改了一下，应该是可以了。

1. (defun C:try ()
   
2.    (setq ss     (ssget ';选择半径大于1小于2的圆
   
3.           ((-4 . "<and")
   
4.             (0 . "circle")
   
5.             (-4 . ">")(40 . 1);圆的半径大于1
   
6.             (-4 . "<")(40 . 2);圆的半径小于2
   
7.            (-4 . "and>")
   
8.           )
   
9.          )
   
10. )  
    
11.    (setq  HH '(6 3) ;选择扩大范围
    
12.           i  -1
    
13.    )  
    
14.       (while (setq ee (entget (ssname ss (setq i (1+ i)))))
    
15.      (setq pt (cdr (assoc 10  ee))
    
16.           pt1 (mapcar '- pt HH)
    
17.           pt2 (mapcar '+ pt HH)
    
18.           ss1 (ssget "C" pt1 pt2)
    
19.      )
    
20. ;(command "RECTANG" pt1 pt2 "");测试选择范围用
    
21.      (command "Scale" ss1 "" pt 0.25)
    
22.    )  
    
23. )

(defun C:try () <br />    (setq ss     (ssget ';选择半径大于1小于2的圆<br />           ((-4 . "<and")<br />             (0 . "circle")<br />             (-4 . ">")(40 . 1);圆的半径大于1<br />             (-4 . "<")(40 . 2);圆的半径小于2<br />            (-4 . "and>")<br />           )<br />          ) <br /> )  <br />    (setq  HH '(6 3) ;选择扩大范围<br />           i  -1<br />    )  <br />       (while (setq ee (entget (ssname ss (setq i (1+ i)))))<br />      (setq pt (cdr (assoc 10  ee))<br />           pt1 (mapcar '- pt HH)<br />           pt2 (mapcar '+ pt HH)<br />           ss1 (ssget "C" pt1 pt2)<br />      )<br /> ;(command "RECTANG" pt1 pt2 "");测试选择范围用<br />      (command "Scale" ss1 "" pt 0.25)<br />    )  <br /> )

依然小小鸟

smartstar 发表于 2018-8-31 10:45
根据楼上大师的代码修改了一下，应该是可以了。

谢谢你的回复 感觉这个代码局限性还是挺大的 一是 圆的半径只能大于1小于2  二是只能缩放0.25  其实我更想借助这个例子 来实现真正的任何实体 以自己的中心点 可以原位的缩放或者放大  

依然小小鸟

Andyhon 发表于 2018-8-30 22:57
(defun C:try ()

   (command "Select"

大神 可以增加选项 然自己缩放任意倍数 或者扩大任意倍数 而且圆的半径不用局限

Andyhon

是的  那只是个框架
得随自己的实务应用而加以调整

学些程序吧 至少得会套用修改以符合实务使用
毕竟靠他人忖度完善程序,免不了要跑调滴...