请高手帮写一个缩放到矩形的代码
请高手帮写一个缩放到矩形的代码我有一个设想，就是在A图层中，画N个方框。这些步骤是手工做的。
再写代码，搜索到这N个方框，将屏幕缩放到每个方框的大小，有几个就缩放几次。则如果看到了我需要的区域，我退出插件运行，则屏幕就到达了我的目的位置。
这样就很容易找到自己的目的位置了。至少不用太费时间和手脚。
希望是真代码，不要是伪代码。 本帖最后由 llsheng_73 于 2013-10-24 17:36 编辑
(defun SStoES(s / m n e)
(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:flzoom();;命令可以自己改
(setq ss(ssget"X"'((0 . "LWPOLYLINE"))));; 要不要手动选择自己考虑或者加上图层限制(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 SStoES(s / m n e)
;;;来源：2楼 请高手帮写一个缩放到矩形的代码-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
;;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108081&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 )
)
有了上面的三套代码，你就可以在你设定的缩放区域不停地循环去看，到了目的区域就停下来 llsheng_73 发表于 2013-10-24 17:35 static/image/common/back.gif
热心好人.........支持一个.....赞
页:
[1]