[LISP程序]：布局视口编程求教

PLgis

对下面的函数,为什么在模型窗口或布局1窗口中执行,会在布局1中创建新视口, 而不是期望的在布局2中创建新视口? 请帮忙指导.

2. 
   
3. ;在布局2上创建一个视口
   
4. (defun CPV2()
   
5.   (vl-load-com)
   
6.   (setq AcadObject   (vlax-get-acad-object)
   
7.         AcadDocument (vla-get-ActiveDocument Acadobject)
   
8.         mSpace       (vla-get-ModelSpace Acaddocument)
   
9.         pSpace       (vla-get-PaperSpace AcadDocument)
   
10.         LayoutSel    (vla-get-Layouts AcadDocument)
    
11. 
    
12.   )
    
13.   (setvar "TILEMODE" 0)
    
14. 
    
15.   ;获得布局2对象Layout2
    
16.   (setq Layout1(vla-item LayoutSel "布局1"))
    
17.   (setq Layout2 (vla-item LayoutSel "布局2"))
    
18. 
    
19.   ;设置Layou2为活动布局
    
20.   (setq layoutSel(vla-get-Layouts AcadDocument))
    
21.   (setq documentSel(vla-get-Documents AcadObject))
    
22.   (setq name(vla-get-Name (vla-get-ActiveDocument AcadObject)))
    
23.   (vla-put-ActiveLayout (vla-Item documentSel name) Layout2)
    
24.   
    
25.   (setq CenterPnt(vlax-make-safearray vlax-vbDouble '(0 . 2)))
    
26.   (vlax-safearray-fill CenterPnt '(40 40 0))
    
27. 
    
28.   (vla-AddPViewport pSpace CenterPnt 20 20)
    
29. )
    

<br /> ;在布局2上创建一个视口<br /> (defun CPV2()<br />   (vl-load-com)<br />   (setq AcadObject   (vlax-get-acad-object)<br />         AcadDocument (vla-get-ActiveDocument Acadobject)<br />         mSpace       (vla-get-ModelSpace Acaddocument)<br />         pSpace       (vla-get-PaperSpace AcadDocument)<br />         LayoutSel    (vla-get-Layouts AcadDocument)<br /> <br />   )<br />   (setvar "TILEMODE" 0)<br /> <br />   ;获得布局2对象Layout2<br />   (setq Layout1(vla-item LayoutSel "布局1"))<br />   (setq Layout2 (vla-item LayoutSel "布局2"))<br /> <br />   ;设置Layou2为活动布局<br />   (setq layoutSel(vla-get-Layouts AcadDocument))<br />   (setq documentSel(vla-get-Documents AcadObject))<br />   (setq name(vla-get-Name (vla-get-ActiveDocument AcadObject)))<br />   (vla-put-ActiveLayout (vla-Item documentSel name) Layout2)<br />   <br />   (setq CenterPnt(vlax-make-safearray vlax-vbDouble '(0 . 2)))<br />   (vlax-safearray-fill CenterPnt '(40 40 0))<br /> <br />   (vla-AddPViewport pSpace CenterPnt 20 20)<br /> )<br />

我跟踪了一下,在执行了(vla-put-ActiveLayout (vla-Item documentSel name) Layout2)后,SPace对象的Layout属性还是指向layout1,而不是Layout2
我没有找到设置sPace的Layout指向的函数,也许这是问题的症结所在.
还请各位网友继续给与指点.

Dream.Fei

才看到。
(vla-put-activelayout AcadDocument (vla-item LayoutSel "布局2"))

carrot1983

"布局2"没错啊!
能不能贴个像天正里面的"定义视口"

PLgis

确实如2楼所示。
向Dream.Fei 深表谢意。

Dream.Fei

一年前的帖子你也能等， 服！
帖个半成品的定义视口，还望高手来指点。

2. 
   
3. (defun c:x1 (/ aout bl cen doc hei outsel p1 p2 ps pv wid)
   
4.   (setq        doc    (vla-get-activedocument (vlax-get-acad-object))
   
5.         outsel (vla-get-layouts doc)
   
6.         aout   (vla-item outsel (getvar "ctab"))
   
7.         ps     (vla-get-paperspace doc)
   
8.   )
   
9.   (if (/= (getvar "ctab") "Model")
   
10.     (progn
    
11.       (vlax-put doc 'activespace acmodelspace)
    
12.       (if (setq p1 (getpoint "\n左下角:"))
    
13.         (if (setq p2 (getcorner p1 "\n右上角:"))
    
14.           (if (setq bl (getint "\n视口比例:"))
    
15.             (progn
    
16.               (setq cen        (list (/ (+ (car p1) (car p2)) 2.0)
    
17.                               (/ (+ (cadr p1) (cadr p2)) 2.0)
    
18.                               (/ (+ (caddr p1) (caddr p2)) 2.0)
    
19.                         )
    
20.                     bl        (/ 1.0 bl)
    
21.                     wid        (* (abs (- (car p2) (car p1))) bl)
    
22.                     hei        (* (abs (- (cadr p2) (cadr p1))) bl)
    
23.               )
    
24.               (vlax-put doc 'activelayout aout)
    
25.               (setq pv (vla-addpviewport ps (fei-223 '(0 0)) wid hei))
    
26.               (vlax-put pv 'customscale bl) ;_比例
    
27.               (vlax-put pv 'viewporton :vlax-true) ;_显示模型
    
28.               (vlax-put pv 'ucsiconatorigin :vlax-true)
    
29.               (vlax-put pv 'displaylocked :vlax-true) ;_视口锁定
    
30.             )
    
31.           )
    
32.         )
    
33.       )
    
34.     )
    
35.     (alert "*** 不允许在模型空间使用该命令 ***")
    
36.   )
    
37.   (if pv
    
38.     pv
    
39.     (princ)
    
40.   )
    
41. )
    

<br /> (defun c:x1 (/ aout bl cen doc hei outsel p1 p2 ps pv wid)<br />   (setq        doc    (vla-get-activedocument (vlax-get-acad-object))<br />         outsel (vla-get-layouts doc)<br />         aout   (vla-item outsel (getvar "ctab"))<br />         ps     (vla-get-paperspace doc)<br />   )<br />   (if (/= (getvar "ctab") "Model")<br />     (progn<br />       (vlax-put doc 'activespace acmodelspace)<br />       (if (setq p1 (getpoint "\n左下角:"))<br />         (if (setq p2 (getcorner p1 "\n右上角:"))<br />           (if (setq bl (getint "\n视口比例:"))<br />             (progn<br />               (setq cen        (list (/ (+ (car p1) (car p2)) 2.0)<br />                               (/ (+ (cadr p1) (cadr p2)) 2.0)<br />                               (/ (+ (caddr p1) (caddr p2)) 2.0)<br />                         )<br />                     bl        (/ 1.0 bl)<br />                     wid        (* (abs (- (car p2) (car p1))) bl)<br />                     hei        (* (abs (- (cadr p2) (cadr p1))) bl)<br />               )<br />               (vlax-put doc 'activelayout aout)<br />               (setq pv (vla-addpviewport ps (fei-223 '(0 0)) wid hei))<br />               (vlax-put pv 'customscale bl) ;_比例<br />               (vlax-put pv 'viewporton :vlax-true) ;_显示模型<br />               (vlax-put pv 'ucsiconatorigin :vlax-true)<br />               (vlax-put pv 'displaylocked :vlax-true) ;_视口锁定<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (alert "*** 不允许在模型空间使用该命令 ***")<br />   )<br />   (if pv<br />     pv<br />     (princ)<br />   )<br /> )<br />

视口大小及比例都没问题了，问题在于不能准确显示模型空间的对象。不知道视口与模型空间是怎么对应的。

PLgis

"一年前的帖子你也能等",非也.能见到赐教,还是要表示谢意.
下面是当年该应用中的片断,供参考:

2. 
   
3. 
   
4.   ;创建视口1
   
5.         ...
   
6.   (setq pviewportObj1 (vla-AddPViewport pSpace pvCenterPnt pvWidth1 pvHeight1));在图纸空间创建视口1
   
7. 
   
8.   ;创建视口2
   
9.         ...
   
10.   (setq pviewportObj2 (vla-AddPViewport pSpace pvCenterPnt pvWidth2 pvHeight2));在图纸空间创建视口2
    
11. 
    
12.   ;进入模型空间
    
13.         ;准备要放入视口的对象
    
14.         ...
    
15. 
    
16.       ;设置布局中的视口
    
17.       (vla-put-ActiveSpace AcadDocument acPaperSpace);从模型空间切换到上一个活动的图纸空间布局
    
18.       (vla-put-ActiveLayout AcadDocument sdtLayout)
    
19.       
    
20.       (vla-Display pviewportObj2 :vlax-true);启用视口
    
21.       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间
    
22.       (vla-put-ActivePViewport Acaddocument pviewportObj2);将 pviewportObj2 置为当前
    
23. 
    
24.       ;模型空间中，准备放入布局视口的范围
    
25.       (setq LowerLeft(vlax-3d-point (list (car w1)(cadr w1) 0.0)) UpperRight(vlax-3d-point (list (car w2)(cadr w2) 0.0)))
    
26.       (vla-ZoomWindow AcadObject LowerLeft UpperRight);在模型空间中进行范围缩放
    
27.       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑
    
28. 
    
29.       (vla-Display pviewportObj1 :vlax-true);启用视口
    
30.       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间
    
31.       (vla-put-ActivePViewport Acaddocument pviewportObj1);将 pviewportObj1 置为当前
    
32. 
    
33.       ;模型空间中，准备放入布局视口的范围
    
34.       (setq CenterPoint(vlax-3d-point (list (car p0)(cadr p0) 0.0)))
    
35.       (vla-ZoomCenter AcadObject CenterPoint 125.0);在模型空间中进行范围缩放
    
36.       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑
    
37. 
    
38.         ;打印输出栓点图
    
39.         ...
    

<br /> <br />   ;创建视口1<br />         ...<br />   (setq pviewportObj1 (vla-AddPViewport pSpace pvCenterPnt pvWidth1 pvHeight1));在图纸空间创建视口1<br /> <br />   ;创建视口2<br />         ...<br />   (setq pviewportObj2 (vla-AddPViewport pSpace pvCenterPnt pvWidth2 pvHeight2));在图纸空间创建视口2<br /> <br />   ;进入模型空间<br />         ;准备要放入视口的对象<br />         ...<br /> <br />       ;设置布局中的视口<br />       (vla-put-ActiveSpace AcadDocument acPaperSpace);从模型空间切换到上一个活动的图纸空间布局<br />       (vla-put-ActiveLayout AcadDocument sdtLayout)<br />       <br />       (vla-Display pviewportObj2 :vlax-true);启用视口<br />       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间<br />       (vla-put-ActivePViewport Acaddocument pviewportObj2);将 pviewportObj2 置为当前<br /> <br />       ;模型空间中，准备放入布局视口的范围<br />       (setq LowerLeft(vlax-3d-point (list (car w1)(cadr w1) 0.0)) UpperRight(vlax-3d-point (list (car w2)(cadr w2) 0.0)))<br />       (vla-ZoomWindow AcadObject LowerLeft UpperRight);在模型空间中进行范围缩放<br />       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑<br /> <br />       (vla-Display pviewportObj1 :vlax-true);启用视口<br />       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间<br />       (vla-put-ActivePViewport Acaddocument pviewportObj1);将 pviewportObj1 置为当前<br /> <br />       ;模型空间中，准备放入布局视口的范围<br />       (setq CenterPoint(vlax-3d-point (list (car p0)(cadr p0) 0.0)))<br />       (vla-ZoomCenter AcadObject CenterPoint 125.0);在模型空间中进行范围缩放<br />       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑<br /> <br />         ;打印输出栓点图<br />         ...<br />

PLgis

"一年前的帖子你也能等",非也.能见到赐教,还是要表示谢意.
下面是当年该应用中的片断,供参考:

2. 
   
3. 
   
4.   ;创建视口1
   
5.         ...
   
6.   (setq pviewportObj1 (vla-AddPViewport pSpace pvCenterPnt pvWidth1 pvHeight1));在图纸空间创建视口1
   
7. 
   
8.   ;创建视口2
   
9.         ...
   
10.   (setq pviewportObj2 (vla-AddPViewport pSpace pvCenterPnt pvWidth2 pvHeight2));在图纸空间创建视口2
    
11. 
    
12.   ;进入模型空间
    
13.         ;准备要放入视口的对象
    
14.         ...
    
15. 
    
16.       ;设置布局中的视口
    
17.       (vla-put-ActiveSpace AcadDocument acPaperSpace);从模型空间切换到上一个活动的图纸空间布局
    
18.       (vla-put-ActiveLayout AcadDocument sdtLayout)
    
19.       
    
20.       (vla-Display pviewportObj2 :vlax-true);启用视口
    
21.       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间
    
22.       (vla-put-ActivePViewport Acaddocument pviewportObj2);将 pviewportObj2 置为当前
    
23. 
    
24.       ;模型空间中，准备放入布局视口的范围
    
25.       (setq LowerLeft(vlax-3d-point (list (car w1)(cadr w1) 0.0)) UpperRight(vlax-3d-point (list (car w2)(cadr w2) 0.0)))
    
26.       (vla-ZoomWindow AcadObject LowerLeft UpperRight);在模型空间中进行范围缩放
    
27.       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑
    
28. 
    
29.       (vla-Display pviewportObj1 :vlax-true);启用视口
    
30.       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间
    
31.       (vla-put-ActivePViewport Acaddocument pviewportObj1);将 pviewportObj1 置为当前
    
32. 
    
33.       ;模型空间中，准备放入布局视口的范围
    
34.       (setq CenterPoint(vlax-3d-point (list (car p0)(cadr p0) 0.0)))
    
35.       (vla-ZoomCenter AcadObject CenterPoint 125.0);在模型空间中进行范围缩放
    
36.       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑
    
37. 
    
38.         ;打印输出
    
39.         ...
    

<br /> <br />   ;创建视口1<br />         ...<br />   (setq pviewportObj1 (vla-AddPViewport pSpace pvCenterPnt pvWidth1 pvHeight1));在图纸空间创建视口1<br /> <br />   ;创建视口2<br />         ...<br />   (setq pviewportObj2 (vla-AddPViewport pSpace pvCenterPnt pvWidth2 pvHeight2));在图纸空间创建视口2<br /> <br />   ;进入模型空间<br />         ;准备要放入视口的对象<br />         ...<br /> <br />       ;设置布局中的视口<br />       (vla-put-ActiveSpace AcadDocument acPaperSpace);从模型空间切换到上一个活动的图纸空间布局<br />       (vla-put-ActiveLayout AcadDocument sdtLayout)<br />       <br />       (vla-Display pviewportObj2 :vlax-true);启用视口<br />       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间<br />       (vla-put-ActivePViewport Acaddocument pviewportObj2);将 pviewportObj2 置为当前<br /> <br />       ;模型空间中，准备放入布局视口的范围<br />       (setq LowerLeft(vlax-3d-point (list (car w1)(cadr w1) 0.0)) UpperRight(vlax-3d-point (list (car w2)(cadr w2) 0.0)))<br />       (vla-ZoomWindow AcadObject LowerLeft UpperRight);在模型空间中进行范围缩放<br />       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑<br /> <br />       (vla-Display pviewportObj1 :vlax-true);启用视口<br />       (vla-put-MSpace Acaddocument :vlax-true);切换到模型空间<br />       (vla-put-ActivePViewport Acaddocument pviewportObj1);将 pviewportObj1 置为当前<br /> <br />       ;模型空间中，准备放入布局视口的范围<br />       (setq CenterPoint(vlax-3d-point (list (car p0)(cadr p0) 0.0)))<br />       (vla-ZoomCenter AcadObject CenterPoint 125.0);在模型空间中进行范围缩放<br />       (vla-put-MSpace Acaddocument :vlax-false);关闭模型空间编辑<br /> <br />         ;打印输出<br />         ...<br />

Dream.Fei

呵呵，昨天搞到半夜才搞定，模拟天正定义视口。

注意事项：
1、由于在返回布局后移动使用的是系统函数grread，所以不能在移动过程中进行任何键盘操作。（事实上，我也并不觉得在布置视口的时候键盘操作的重要性）
2、如果想让视口出现在指定布局，则应该从这个布局发出命令。如果是在模型空间发出的命令，则会在第一个布局上创建视口。

疑问：
1、vla-addpviewport 没有问题，但为什么 vlax-invoke 'addpviewport却出错？

2. 
   
3. (defun fei-viewport-add
   
4.        (/ *acad* *adoc* *alot* *lotsel* *pspace* bl ctab hei loop mod p1 p2 pt pv vp vps wid)
   
5.   (setq        *acad*         (vlax-get-acad-object) ;_应用程序
   
6.         *adoc*         (vla-get-activedocument *acad*) ;_当前文档
   
7.         *pspace* (vla-get-paperspace *adoc*) ;_图纸空间
   
8.         *lotsel* (vla-get-layouts *adoc*) ;_选项卡集合
   
9.         ctab         (getvar "ctab") ;_记录当前是模型还是图纸空间
   
10.         *alot*         (vla-item *lotsel* (getvar "ctab")) ;_当前选项卡
    
11.         loop         t
    
12.   )
    
13.   (vla-put-activespace *adoc* acmodelspace) ;_返回模型空间
    
14.   (if (setq p1 (getpoint "\n 视口左下角:"))
    
15.     (if        (setq p2 (getcorner p1 "\n 视口右上角:"))
    
16.       (if (setq bl (getint "\n 视口比例:"))
    
17.         (progn
    
18.           (setq        bl  (/ 1.0 bl) ;_获取比例
    
19.                 wid (* (abs (- (car p2) (car p1))) bl) ;_计算宽度
    
20.                 hei (* (abs (- (cadr p2) (cadr p1))) bl) ;_计算长度
    
21.           )
    
22.           (if (= ctab "Model")
    
23.             (vla-put-activespace *adoc* acpaperspace) ;_返回第一个选项卡
    
24.             (vla-put-activelayout *adoc* *alot*) ;_返回存储前的选项卡
    
25.           )
    
26.           (setq pv (vla-addpviewport *pspace* (vlax-3d-point '(0 0)) wid hei)) ;_创建视口
    
27.           (vla-put-viewporton pv :vlax-true) ;_显示模型
    
28.           (vla-put-mspace *adoc* :vlax-true) ;_返回模型空间
    
29.           (vlax-invoke *acad* 'zoomwindow p1 p2) ;_缩放操作以确定显示区域
    
30.           (vla-put-mspace *adoc* :vlax-false) ;_返回图纸空间
    
31.           (vla-put-customscale pv bl) ;_比例
    
32.           (vla-put-ucsiconatorigin pv :vlax-true) ;_显示原点
    
33.           (vla-put-displaylocked pv :vlax-true) ;_视口锁定
    
34.           ;;_移动
    
35.           (while loop
    
36.             (setq pt  (vlax-get pv 'center)
    
37.                   pt  (list (- (car pt) (/ wid 2.0))
    
38.                             (- (cadr pt) (/ hei 2.0))
    
39.                       )
    
40.                   vps (grread t 4 0)
    
41.                   vp  (cadr vps)
    
42.                   mod (car vps)
    
43.             )
    
44.             (if        (= mod 5)
    
45.               (vla-move pv (vlax-3d-point pt) (vlax-3d-point vp))
    
46.               (setq loop nil)
    
47.             )
    
48.           )
    
49.         )
    
50.       )
    
51.     )
    
52.   )
    
53.   (if pv
    
54.     pv
    
55.     nil
    
56.   )
    
57. )
    

<br /> (defun fei-viewport-add<br />        (/ *acad* *adoc* *alot* *lotsel* *pspace* bl ctab hei loop mod p1 p2 pt pv vp vps wid)<br />   (setq        *acad*         (vlax-get-acad-object) ;_应用程序<br />         *adoc*         (vla-get-activedocument *acad*) ;_当前文档<br />         *pspace* (vla-get-paperspace *adoc*) ;_图纸空间<br />         *lotsel* (vla-get-layouts *adoc*) ;_选项卡集合<br />         ctab         (getvar "ctab") ;_记录当前是模型还是图纸空间<br />         *alot*         (vla-item *lotsel* (getvar "ctab")) ;_当前选项卡<br />         loop         t<br />   )<br />   (vla-put-activespace *adoc* acmodelspace) ;_返回模型空间<br />   (if (setq p1 (getpoint "\n 视口左下角:"))<br />     (if        (setq p2 (getcorner p1 "\n 视口右上角:"))<br />       (if (setq bl (getint "\n 视口比例:"))<br />         (progn<br />           (setq        bl  (/ 1.0 bl) ;_获取比例<br />                 wid (* (abs (- (car p2) (car p1))) bl) ;_计算宽度<br />                 hei (* (abs (- (cadr p2) (cadr p1))) bl) ;_计算长度<br />           )<br />           (if (= ctab "Model")<br />             (vla-put-activespace *adoc* acpaperspace) ;_返回第一个选项卡<br />             (vla-put-activelayout *adoc* *alot*) ;_返回存储前的选项卡<br />           )<br />           (setq pv (vla-addpviewport *pspace* (vlax-3d-point '(0 0)) wid hei)) ;_创建视口<br />           (vla-put-viewporton pv :vlax-true) ;_显示模型<br />           (vla-put-mspace *adoc* :vlax-true) ;_返回模型空间<br />           (vlax-invoke *acad* 'zoomwindow p1 p2) ;_缩放操作以确定显示区域<br />           (vla-put-mspace *adoc* :vlax-false) ;_返回图纸空间<br />           (vla-put-customscale pv bl) ;_比例<br />           (vla-put-ucsiconatorigin pv :vlax-true) ;_显示原点<br />           (vla-put-displaylocked pv :vlax-true) ;_视口锁定<br />           ;;_移动<br />           (while loop<br />             (setq pt  (vlax-get pv 'center)<br />                   pt  (list (- (car pt) (/ wid 2.0))<br />                             (- (cadr pt) (/ hei 2.0))<br />                       )<br />                   vps (grread t 4 0)<br />                   vp  (cadr vps)<br />                   mod (car vps)<br />             )<br />             (if        (= mod 5)<br />               (vla-move pv (vlax-3d-point pt) (vlax-3d-point vp))<br />               (setq loop nil)<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (if pv<br />     pv<br />     nil<br />   )<br /> )<br />

另外聊个不关新建视口的问题：
vla-put-activelayout后，如果光标正好落在一个视口内，则会自动激活该视口（相当于发出 mspace命令）。如何能阻止？我想要的就是在跳转布局后，依然位于图纸空间，而不是自动激活模型空间。
试过在跳转后紧跟一句: vla-put-mspace doc :vlax-false，但没用。也试过直接发送pspace命令，但同样不能保证。
感觉只要跳转后光标位于视口内就一定会自动激活该视口，还望指点。

寒风

不知多义线视口如何创建?

party0955

好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!好!!

lzj511

Fei 能否分享个完整程序？

zteykmgscqh

也许这个刚好可以解决我的帖子问题，测试一下

gdys

如何在一个布局批量生成视口