如何获取视口角点在模型中的坐标？

ygp820601

布局中，我建立了一个矩形视口，
怎样知道视口角点对应在模型中的点在模型中的坐标呢？

crazylsp

系统变量里面好像有个VSMIN虚屏,也想知道和视口有什么关系？

ygp820601

貌似不对啊，VSMIN是整个模型的吧，不是局部区域的

菡萏

参阅 trans 函数的用法！

e2002

1. ;;; https://jtbworld.com/autocad-vp-outline-lsp
   
2. 
   
3. ;;; vp-outline.lsp
   
4. ;;;
   
5. ;;; Creates a polyline in modelspace that
   
6. ;;; has the outline of the selected viewport.
   
7. ;;; Supports clipped viewports. polyline is supported
   
8. ;;; ellipse, spline, region and circle not supported at this point
   
9. ;;; If vp-outline is called when in mspace it detects
   
10. ;;; the active viewport.
    
11. ;;;
    
12. ;;; c:vp-outline
    
13. ;;;
    
14. ;;; By Jimmy Bergmark
    
15. ;;; Copyright (C) 1997-2013 JTB World, All Rights Reserved
    
16. ;;; Website: www.jtbworld.com
    
17. ;;; E-mail: info@jtbworld.com
    
18. ;;;
    
19. ;;; 2000-04-10
    
20. ;;; 2003-11-19 Added support for drawing the outline in other ucs/view than world/current
    
21. ;;;
    
22. ;;; 2006-04-06 Added support for twisted views Tom Beauford
    
23. ;;; 2013-06-08 Added support for circular viewports
    
24. ;;;
    
25. ;;; Should work on AutoCAD 2000 and newer
    
26. (vl-load-com)
    
27. 
    
28. (defun dxf (n ed) (cdr (assoc n ed)))
    
29. 
    
30. (defun axist->VariantArray (lst)
    
31.   (vlax-Make-Variant
    
32.     (vlax-SafeArray-Fill
    
33.       (vlax-Make-SafeArray
    
34.   vlax-vbDouble
    
35.   (cons 0 (- (length lst) 1))
    
36.       )
    
37.       lst
    
38.     )
    
39.   )
    
40. )
    
41. 
    
42. (defun c:vp-outline (/ ad ss ent pl plist xy n vpbl vpur msbl msur ven vpno ok
    
43.          circ)
    
44.   (setq ad (vla-get-activedocument (vlax-get-acad-object)))
    
45.   (if (= (getvar "tilemode") 0)
    
46.     (progn
    
47.       (if (= (getvar "cvport") 1)
    
48.   (progn
    
49.     (if (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))
    
50.       (progn (setq ent (ssname ss 0))
    
51.        (setq vpno (dxf 69 (entget ent)))
    
52.        (vla-Display (vlax-ename->vla-object ent) :vlax-true)
    
53.        (vla-put-mspace ad :vlax-true) ; equal (command "._mspace")
    
54. ; this to ensure trans later is working on correct viewport
    
55.        (setvar "cvport" vpno)
    
56. ;              (vla-put-mspace ad :vlax-false) ; equal (command "._pspace")
    
57.        (setq ok T)
    
58.        (setq ss nil)
    
59.       )
    
60.     )
    
61.   )
    
62.   (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))
    
63.         ok  T
    
64.   )
    
65.       )
    
66.       (if ok
    
67.   (progn (setq circle nil)
    
68.          (setq ven (vlax-ename->vla-object ent))
    
69.          (if (/= 1 (logand 1 (dxf 90 (entget ent)))) ; detect perspective
    
70.      (progn  (if (= (vla-get-clipped ven) :vlax-false)
    
71.         (progn ; not clipped
    
72.           (vla-getboundingbox ven 'vpbl 'vpur)
    
73.           (setq vpbl  (trans (vlax-safearray->list vpbl) 3 2)
    
74.           msbl  (trans vpbl 2 1)
    
75.           msbl  (trans msbl 1 0)
    
76.           vpur  (trans (vlax-safearray->list vpur) 3 2)
    
77.           msur  (trans vpur 2 1)
    
78.           msur  (trans msur 1 0)
    
79.           vpbr  (list (car vpur) (cadr vpbl) 0)
    
80.           msbr  (trans vpbr 2 1)
    
81.           msbr  (trans msbr 1 0)
    
82.           vpul  (list (car vpbl) (cadr vpur) 0)
    
83.           msul  (trans vpul 2 1)
    
84.           msul  (trans msul 1 0)
    
85.           plist  (list (car msbl)
    
86.                 (cadr msbl)
    
87.                 (car msbr)
    
88.                 (cadr msbr)
    
89.                 (car msur)
    
90.                 (cadr msur)
    
91.                 (car msul)
    
92.                 (cadr msul)
    
93.           )
    
94.           )
    
95.         )
    
96.         (progn ; clipped
    
97.           (setq pl (entget (dxf 340 (entget ent))))
    
98.           (if  (= (dxf 0 pl) "CIRCLE")
    
99.             (setq circle T)
    
100.             (progn (setq plist (vla-get-coordinates
     
101.                (vlax-ename->vla-object (dxf -1 pl))
     
102.              )
     
103.              plist (vlax-safearray->list (vlax-variant-value plist))
     
104.              n   0
     
105.              pl   nil
     
106.              )
     
107.              (repeat (/ (length plist) 2)
     
108.                (setq xy  (trans (list (nth n plist) (nth (1+ n) plist)) 3 2)
     
109.                xy  (trans xy 2 1)
     
110.                xy  (trans xy 1 0)
     
111.                pl  (cons (car xy) pl)
     
112.                pl  (cons (cadr xy) pl)
     
113.                n  (+ n 2)
     
114.                )
     
115.              )
     
116.              (setq plist (reverse pl))
     
117.             )
     
118.           )
     
119.         )
     
120.       )
     
121.       (if circle
     
122.         (vla-AddCircle
     
123.           (vla-get-ModelSpace ad)
     
124.           (axist->VariantArray
     
125.             (trans (trans (trans (dxf 10 pl) 1 0) 2 1) 3 2)
     
126.           )
     
127.           (/ (dxf 40 pl) (caddr (trans '(0 0 1) 2 3)))
     
128.         )
     
129.         (vla-Put-Closed
     
130.           (vla-AddLightWeightPolyline
     
131.             (vla-get-ModelSpace ad)
     
132.             (axist->VariantArray plist)
     
133.           )
     
134.           :vlax-True
     
135.         )
     
136.       )
     
137.      )
     
138.          )
     
139.   )
     
140.       )
     
141.     )
     
142.   )
     
143.   (if ss
     
144.     (vla-put-mspace ad :vlax-false)
     
145.   ) ; equal (command "._pspace"))
     
146.   (princ)
     
147. )
     

;;; <a href="https://jtbworld.com/autocad-vp-outline-lsp" target="_blank">https://jtbworld.com/autocad-vp-outline-lsp</a><br /> <br /> ;;; vp-outline.lsp<br /> ;;;<br /> ;;; Creates a polyline in modelspace that<br /> ;;; has the outline of the selected viewport.<br /> ;;; Supports clipped viewports. polyline is supported<br /> ;;; ellipse, spline, region and circle not supported at this point<br /> ;;; If vp-outline is called when in mspace it detects<br /> ;;; the active viewport.<br /> ;;;<br /> ;;; c:vp-outline<br /> ;;;<br /> ;;; By Jimmy Bergmark<br /> ;;; Copyright (C) 1997-2013 JTB World, All Rights Reserved<br /> ;;; Website: <a href="http://www.jtbworld.com" target="_blank">www.jtbworld.com</a><br /> ;;; E-mail: <a href="mailto:info@jtbworld.com">info@jtbworld.com</a><br /> ;;;<br /> ;;; 2000-04-10<br /> ;;; 2003-11-19 Added support for drawing the outline in other ucs/view than world/current<br /> ;;;<br /> ;;; 2006-04-06 Added support for twisted views Tom Beauford<br /> ;;; 2013-06-08 Added support for circular viewports<br /> ;;;<br /> ;;; Should work on AutoCAD 2000 and newer<br /> (vl-load-com)<br /> <br /> (defun dxf (n ed) (cdr (assoc n ed)))<br /> <br /> (defun ax<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />ist->VariantArray (lst)<br />   (vlax-Make-Variant<br />     (vlax-SafeArray-Fill<br />       (vlax-Make-SafeArray<br />   vlax-vbDouble<br />   (cons 0 (- (length lst) 1))<br />       )<br />       lst<br />     )<br />   )<br /> )<br /> <br /> (defun c:vp-outline (/ ad ss ent pl plist xy n vpbl vpur msbl msur ven vpno ok<br />          circ)<br />   (setq ad (vla-get-activedocument (vlax-get-acad-object)))<br />   (if (= (getvar "tilemode") 0)<br />     (progn<br />       (if (= (getvar "cvport") 1)<br />   (progn<br />     (if (setq ss (ssget ":E:S" '((0 . "VIEWPORT"))))<br />       (progn (setq ent (ssname ss 0))<br />        (setq vpno (dxf 69 (entget ent)))<br />        (vla-Display (vlax-ename->vla-object ent) :vlax-true)<br />        (vla-put-mspace ad :vlax-true) ; equal (command "._mspace")<br /> ; this to ensure trans later is working on correct viewport<br />        (setvar "cvport" vpno)<br /> ;              (vla-put-mspace ad :vlax-false) ; equal (command "._pspace")<br />        (setq ok T)<br />        (setq ss nil)<br />       )<br />     )<br />   )<br />   (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))<br />         ok  T<br />   )<br />       )<br />       (if ok<br />   (progn (setq circle nil)<br />          (setq ven (vlax-ename->vla-object ent))<br />          (if (/= 1 (logand 1 (dxf 90 (entget ent)))) ; detect perspective<br />      (progn  (if (= (vla-get-clipped ven) :vlax-false)<br />         (progn ; not clipped<br />           (vla-getboundingbox ven 'vpbl 'vpur)<br />           (setq vpbl  (trans (vlax-safearray->list vpbl) 3 2)<br />           msbl  (trans vpbl 2 1)<br />           msbl  (trans msbl 1 0)<br />           vpur  (trans (vlax-safearray->list vpur) 3 2)<br />           msur  (trans vpur 2 1)<br />           msur  (trans msur 1 0)<br />           vpbr  (list (car vpur) (cadr vpbl) 0)<br />           msbr  (trans vpbr 2 1)<br />           msbr  (trans msbr 1 0)<br />           vpul  (list (car vpbl) (cadr vpur) 0)<br />           msul  (trans vpul 2 1)<br />           msul  (trans msul 1 0)<br />           plist  (list (car msbl)<br />                 (cadr msbl)<br />                 (car msbr)<br />                 (cadr msbr)<br />                 (car msur)<br />                 (cadr msur)<br />                 (car msul)<br />                 (cadr msul)<br />           )<br />           )<br />         )<br />         (progn ; clipped<br />           (setq pl (entget (dxf 340 (entget ent))))<br />           (if  (= (dxf 0 pl) "CIRCLE")<br />             (setq circle T)<br />             (progn (setq plist (vla-get-coordinates<br />                (vlax-ename->vla-object (dxf -1 pl))<br />              )<br />              plist (vlax-safearray->list (vlax-variant-value plist))<br />              n   0<br />              pl   nil<br />              )<br />              (repeat (/ (length plist) 2)<br />                (setq xy  (trans (list (nth n plist) (nth (1+ n) plist)) 3 2)<br />                xy  (trans xy 2 1)<br />                xy  (trans xy 1 0)<br />                pl  (cons (car xy) pl)<br />                pl  (cons (cadr xy) pl)<br />                n  (+ n 2)<br />                )<br />              )<br />              (setq plist (reverse pl))<br />             )<br />           )<br />         )<br />       )<br />       (if circle<br />         (vla-AddCircle<br />           (vla-get-ModelSpace ad)<br />           (ax<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />ist->VariantArray<br />             (trans (trans (trans (dxf 10 pl) 1 0) 2 1) 3 2)<br />           )<br />           (/ (dxf 40 pl) (caddr (trans '(0 0 1) 2 3)))<br />         )<br />         (vla-Put-Closed<br />           (vla-AddLightWeightPolyline<br />             (vla-get-ModelSpace ad)<br />             (ax<img src="static/image/smiley/default/sweat.gif" smilieid="10" border="0" alt="" />ist->VariantArray plist)<br />           )<br />           :vlax-True<br />         )<br />       )<br />      )<br />          )<br />   )<br />       )<br />     )<br />   )<br />   (if ss<br />     (vla-put-mspace ad :vlax-false)<br />   ) ; equal (command "._pspace"))<br />   (princ)<br /> )<br />

ygp820601

e2002 发表于 2012-7-16 17:09

十分感谢各位大侠的帮助，我在琢磨下。