请高手帮写一个缩放到矩形的代码

清风明月名字

请高手帮写一个缩放到矩形的代码
我有一个设想，就是在A图层中，画N个方框。这些步骤是手工做的。
再写代码，搜索到这N个方框，将屏幕缩放到每个方框的大小，有几个就缩放几次。则如果看到了我需要的区域，我退出插件运行，则屏幕就到达了我的目的位置。
这样就很容易找到自己的目的位置了。至少不用太费时间和手脚。
希望是真代码，不要是伪代码。

llsheng_73

1. (defun SStoES(s / m n e)
   
2.   (if s(progn
   
3.    (setq n(sslength s)m 0)
   
4.    (while(< m n)
   
5.      (setq e(if e(append e(list(ssname s m)))(list(ssname s m)))m(1+ m))))
   
6.     )e)
   
7. 
   
8. (defun c:flzoom();;命令可以自己改
   
9.   (setq ss(ssget"X"'((0 . "LWPOLYLINE"))));; 要不要手动选择自己考虑或者加上图层限制(ssget"X"'((0 . "LWPOLYLINE")(8 . "图层名")))
   
10.   (setq ss(sstoes ss))
    
11.   (foreach e ss()
    
12.     (vla-getboundingbox(vlax-ename->vla-object e)'p1 'p2)
    
13.     (setq p1(vlax-safearray->list p1)
    
14.     p2(vlax-safearray->list p2)
    
15.     stay nil)
    
16.     (command"ZOOM""W"p1 p2)
    
17.     (while (null stay)(setq stay (getstring"\n想停留在这一区域ESC,任意键到下一区域......")))
    
18.     )
    
19.   )

(defun SStoES(s / m n e)<br />   (if s(progn<br />    (setq n(sslength s)m 0)<br />    (while(< m n)<br />      (setq e(if e(append e(list(ssname s m)))(list(ssname s m)))m(1+ m))))<br />     )e)<br /> <br /> (defun c:flzoom();;命令可以自己改<br />   (setq ss(ssget"X"'((0 . "LWPOLYLINE"))));; 要不要手动选择自己考虑或者加上图层限制(ssget"X"'((0 . "LWPOLYLINE")(8 . "图层名")))<br />   (setq ss(sstoes ss))<br />   (foreach e ss()<br />     (vla-getboundingbox(vlax-ename->vla-object e)'p1 'p2)<br />     (setq p1(vlax-safearray->list p1)<br />     p2(vlax-safearray->list p2)<br />     stay nil)<br />     (command"ZOOM""W"p1 p2)<br />     (while (null stay)(setq stay (getstring"\n想停留在这一区域ESC,任意键到下一区域......")))<br />     )<br />   )

清风明月名字

下面代码加了一个指定图层
(defun SStoES(s / m n e)
;;;来源：2楼 请高手帮写一个缩放到矩形的代码-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
;;;http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid614906
;;;  请高手帮写一个缩放到矩形的代码
;;;我有一个设想，就是在A图层中，画N个方框。这些步骤是手工做的。
;;;再写代码，搜索到这N个方框，将屏幕缩放到每个方框的大小，有几个就缩放几次。则如果看到了我需要的区域，我退出插件运行，则屏幕就到达了我的目的位置。
;;;这样就很容易找到自己的目的位置了。至少不用太费时间和手脚。
;;;希望是真代码，不要是伪代码。
  (if s(progn
   (setq n(sslength s)m 0)
   (while(< m n)
     (setq e(if e(append e(list(ssname s m)))(list(ssname s m)))m(1+ m))))
    )e)

(defun c:缩放到000缩放到轻多义线图层中的多段线();;命令可以自己改
  (setq ss(ssget"X"'((0 . "LWPOLYLINE")(8 . "000缩放到轻多义线"))));; 要不要手动选择自己考虑或者加上图层限制(ssget"X"'((0 . "LWPOLYLINE")(8 . "图层名")))
  (setq ss(sstoes ss))
  (foreach e ss()
    (vla-getboundingbox(vlax-ename->vla-object e)'p1 'p2)
    (setq p1(vlax-safearray->list p1)
    p2(vlax-safearray->list p2)
    stay nil)
    (command"ZOOM""W"p1 p2)
    (while (null stay)(setq stay (getstring"\n想停留在这一区域ESC,任意键到下一区域......")))
    )
  )

清风明月名字

这是配合上面代码用的，
(DEFUN C:在000缩放到轻多义线图层中画矩形 ( )
(setq oldOsmode (getvar "osMode"))
        (setvar "osMode" 0)
        
        

(princ "\n选取矩形的两个对角点，画矩形:")
(command "RECTANG" PAUSE PAUSE) ;;通过对角坐标画一个矩形。
(setq 图元名 (entlast));选择集的集合，其实是图元名集合

(setq 新图层点对 (cons 8 "000缩放到轻多义线"))
  
      (setq 图元组码 (entget 图元名))
      
        (setq 旧图层点对 (assoc '8 图元组码))
        (setq 图元组码 (subst 新图层点对 旧图层点对 图元组码))
        (entmod 图元组码)
       (command "-layer" "P" "N" "000缩放到轻多义线" "")
  (setvar "osMode" oldOsmode)
  (princ )
      
)

清风明月名字

这也是配合2楼代码用的
(DEFUN C:在000缩放到轻多义线图层中画轻多义线 ( )
; 在000缩放到轻多义线图层中画轻多义线
(setq oldOsmode (getvar "osMode"))
(setvar "osMode" 0)
(princ "\n选取轻多义线的点，画轻多义线:")
(command "pline" PAUSE) ;;画一个轻多义线。
(command PAUSE) ;;没有这一句，一定是画成封闭多义线
(setq 图元名 (entlast));选择集的集合，其实是图元名集合
(setq 新图层点对 (cons 8 "000缩放到轻多义线"))
(setq 图元组码 (entget 图元名))
(setq 旧图层点对 (assoc '8 图元组码))
(setq 图元组码 (subst 新图层点对 旧图层点对 图元组码))
(entmod 图元组码)
(command "-layer" "P" "N" "000缩放到轻多义线" "")
(setvar "osMode" oldOsmode)
  (princ )   
)

清风明月名字

有了上面的三套代码，你就可以在你设定的缩放区域不停地循环去看，到了目的区域就停下来

ysq101

llsheng_73 发表于 2013-10-24 17:35

热心好人.........支持一个.....赞