vernonlee Posted October 22, 2014 Author Share Posted October 22, 2014 I've made this one, using a different approach (vl-load-com) (defun C:CPVP (/ *error* acObj acDoc vp enti p1 p2 enti cen sc newcen dims) (setq acObj (vlax-get-acad-object) acdoc (vla-get-activedocument acObj) ) (vla-startundomark acDoc) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)) ) (if (= 8 (logand (getvar 'undoctl) ) (vla-endundomark acDoc) ) (princ) ) (if (and (setq vp (ssget ":E:S:L" '((0 . "VIEWPORT")))) (setq p1 (getpoint "\nFirst corner: ")) (setq p2 (getcorner p1 "\nSecond corner: ")) ) (progn (setq p1 (trans p1 1 0) p2 (trans p2 1 0) enti (vla-copy (vlax-ename->vla-object (ssname vp 0))) sc (vla-get-CustomScale enti) newcen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2) dims (mapcar '- p2 p1) ) (if (= (vla-get-clipped enti) :vlax-true) (command "_clip" (vlax-vla-object->ename enti) "_d") ) (vla-update enti) (setq cen (vlax-get enti 'center)) (vla-put-mspace acdoc :vlax-true) (vla-put-activepviewport acdoc enti) (vla-zoomCenter acObj (vlax-3d-point (trans (trans newcen 3 2) 2 0)) 1) (vla-put-mspace acdoc :vlax-false) (vla-put-width enti (abs (car dims))) (vla-put-height enti (abs (cadr dims))) (vla-put-center enti (vlax-3d-point newcen)) (vla-put-CustomScale enti sc) (command "_move" (vlax-vla-object->ename enti) "" "_non" p1) (while (> (getvar 'cmdactive) 0) (command "\\") ) ) ) (*error* nil) (princ) ) OMG it worked Thanks to Stefan you have no idea how much time & effort you have saved me:celebrate: Thanks David also for continuously helping me out Quote Link to comment Share on other sites More sharing options...
vernonlee Posted October 23, 2014 Author Share Posted October 23, 2014 I've made this one, using a different approach Hi Stefan, If you could, perhaps you can remove the displacement option if possible. I would not need that as it will always (without fail) be in the same location. It would speed up the process as well. . Thanks Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted October 23, 2014 Share Posted October 23, 2014 (edited) vernonlee said: OMG it worked Thanks to Stefan you have no idea how much time & effort you have saved me:celebrate: Thanks David also for continuously helping me out You're welcome vernonlee. I'm glad it helps you. I always wanted to write a function like this for my own use... I guess I'm to lazy... vernonlee said: Hi Stefan, If you could, perhaps you can remove the displacement option if possible. I would not need that as it will always (without fail) be in the same location. It would speed up the process as well. . Thanks Sure, try this one. It is slightly modified. Now you can continuously create new viewports. (defun C:CPVP (/ *error* get_viewport acObj acDoc vp new_vp p1 p2 new_vp sc new_cen dims vp_border) (vl-load-com) (defun get_viewport (e) (cond ((not e) nil) ((eq (cdr (assoc 0 (entget e))) "VIEWPORT") e) ((vl-some '(lambda (x) (if (eq (cdr (assoc 0 (entget (cdr x)))) "VIEWPORT") (cdr x) ) ) (reverse (cdr (member '(102 . "}") (reverse (cdr (member '(102 . "{ACAD_REACTORS") (entget e))) ) ) ) ) ) )) ) (setq acObj (vlax-get-acad-object) acDoc (vla-get-activedocument acObj) ) (vla-startundomark acDoc) (defun *error* (msg) (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)) ) (if (= 8 (logand (getvar 'undoctl) 8)) (vla-endundomark acDoc) ) (princ) ) (if (and (cond ((= (getvar 'cvport) 1)) ((= (getvar 'tilemode) 0) (vla-put-mspace acdoc :vlax-false) T) ((not (princ "\nNot allowed in ModelSpace"))) ) (progn (while (progn (setvar 'errno 0) (setq vp (car (entsel "\nSelect viewport: "))) (if (= (getvar 'errno) 7) (progn (princ "\nMissed. Try again") (setvar 'errno 0)) (if (not (setq vp (get_viewport vp))) (princ "\nNot a viewport. Try again") ) ) ) ) vp ) ) (while (setq p1 (getpoint "\nFirst corner: ")) (if (and (setq p2 (getcorner p1 "\nSecond corner: ")) (not (equal (rem (angle (setq p1 (trans p1 1 0)) (setq p2 (trans p2 1 0)) ) (/ pi 2.0)) 0.0 1e-8) ) ) (progn (if (setq vp_border (cdr (assoc 340 (entget vp)))) (command "_copy" vp vp_border "" '(0 0 0) '(0 0 0) "_clip" (setq new_vp (get_viewport (entlast))) "_d") (progn (command "_copy" vp "" '(0 0 0) '(0 0 0)) (setq new_vp (entlast)) ) ) (setq new_vp (vlax-ename->vla-object new_vp) sc (vla-get-CustomScale new_vp) new_cen (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2) dims (mapcar '- p2 p1) ) (vla-put-mspace acdoc :vlax-true) (vla-put-activepviewport acdoc new_vp) (vla-zoomCenter acObj (vlax-3d-point (trans (trans new_cen 3 2) 2 0)) 1) (vla-put-mspace acdoc :vlax-false) (vla-put-width new_vp (abs (car dims))) (vla-put-height new_vp (abs (cadr dims))) (vla-put-center new_vp (vlax-3d-point new_cen)) (vla-put-CustomScale new_vp sc) ;;; (command "_move" (vlax-vla-object->ename new_vp) "" "_non" (trans p1 0 1)) ;;; (while (> (getvar 'cmdactive) 0) ;;; (command "\\") ;;; ) ) ) ) ) (*error* nil) (princ) ) Edited July 28, 2022 by Stefan BMR Fixed for clipped viewports Quote Link to comment Share on other sites More sharing options...
vernonlee Posted October 23, 2014 Author Share Posted October 23, 2014 (edited) You're welcome vernonlee. I'm glad it helps you.I always wanted to write a function like this for my own use... I guess I'm to lazy... Sure, try this one. It is slightly modified. Now you can continuously create new viewports. AWESOME!!!!!!!!!!!! Thanks Stefan. you are a life saver. Good thing you had the same idea as well. Kudos to you as well David as it would not have started without you Edited October 23, 2014 by vernonlee Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted October 24, 2014 Share Posted October 24, 2014 Post 23 updated. Now it works properly on clipped viewports. Quote Link to comment Share on other sites More sharing options...
vernonlee Posted October 25, 2014 Author Share Posted October 25, 2014 Post 23 updated. Now it works properly on clipped viewports. Wow. Thanks for the updates. I did encounter some before. Amazing. The previous also works on locked view ports which is excellent. Am now on holiday . Will test it when I am back home. Cheers bro. P/s I forgot to test it, but I hope it follows the original viewport layering settings (example the new viewport can follow the original viewport setting whereby certain layer is off or frozen within the viewport ) Thanks Quote Link to comment Share on other sites More sharing options...
vernonlee Posted October 28, 2014 Author Share Posted October 28, 2014 Post 23 updated. Now it works properly on clipped viewports. Back in the office. The new viewports created using the lisp, will follow the VP states. Except for transparency. But no biggie Regarding the clipped viewports, i realized i do not know that function. Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted October 28, 2014 Share Posted October 28, 2014 Back in the office. The new viewports created using the lisp, will follow the VP states. Except for transparency. But no biggie Regarding the clipped viewports, i realized i do not know that function. Layer's override transparency is an XRECORD attached to the layer object, like any other override properties. I must admit, I didn't check my lisp for any of this override properties, I thought that COPY command will take care of this. It does, for color, linetype and lineweight, but not for transparency, despite the fact that all are managed in the same way by autocad. It might be a bug in autocad. Use matchprop command to solve this situation... About clipped viewports. Mview command has "Object" option. If you create a viewport using this option and you pick a closed shape (polyline, circle, ellipse, region or spline), the result is a clipped viewport. Also, you can use CLIP command to clip an existing viewport. Quote Link to comment Share on other sites More sharing options...
vernonlee Posted October 28, 2014 Author Share Posted October 28, 2014 Layer's override transparency is an XRECORD attached to the layer object, like any other override properties.I must admit, I didn't check my lisp for any of this override properties, I thought that COPY command will take care of this. It does, for color, linetype and lineweight, but not for transparency, despite the fact that all are managed in the same way by autocad. It might be a bug in autocad. Use matchprop command to solve this situation... About clipped viewports. Mview command has "Object" option. If you create a viewport using this option and you pick a closed shape (polyline, circle, ellipse, region or spline), the result is a clipped viewport. Also, you can use CLIP command to clip an existing viewport. Hi Stefan. Like i said no big issue. Honestly what you had written is God sent for me already. Really Thanks for the heads-up on the clip viewport. I also did look it up on my own & realised I mistaken it for something else. Thanks again Stefan. Your contribution will help me immensely. Cheer man Quote Link to comment Share on other sites More sharing options...
vernonlee Posted June 9, 2015 Author Share Posted June 9, 2015 Hi Stefan I have encountered some of the existing drawings that i worked on frequently have errors when running the LISP. Would you know what is wrong? Thanks VIEWPORT NOT ABLE TO CREATE IN THIS DRAWING.dwg Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted June 9, 2015 Share Posted June 9, 2015 Hi vernonlee Try with REGENAUTO set to ON. Quote Link to comment Share on other sites More sharing options...
vernonlee Posted June 10, 2015 Author Share Posted June 10, 2015 Hi vernonlee Try with REGENAUTO set to ON. wow bro. it worked. Not sure why some of the existing drawings I open is Off & some is ON. Any setting I can adjust so that every drawing i open, the REGENAUTO will be set to ON? Is it drawing or my autocad system related? Thanks. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.