Select objects in one viewport, then Zoom to in a new viewport

[rcb007]

I stumbled upon this code which works great in modelspace. It allows to select a pipe network pipe or structure in porfile view, then creates two modelspace viewports and zooms to the plan view of the selected object.

I am trying to figure how I can make this work within Layout Paperspace.

 

If I select a profile pipe network structure, it would prompt for a new viewport in paperspace, then it would zoom to that object.

 

I hope this is not to confusing. lol. Thank you for the eyes and help.

 

(defun c:ZTPS (/ C3D C3DDOC LOCATION NTWRK NTWRKS PROD PRODSTR PointAtParam0 PointAtParam1 OBJ OBJNAME STRUCTURES ZM2OBJ VP1 VP2)
  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))))
  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))))
  (vl-load-com)
  (if (setq C3D	   (strcat "HKEY_LOCAL_MACHINE\\"
			   (if vlax-user-product-key
			     (vlax-user-product-key)
			     (vlax-product-key)
			   )
		   )
	    C3D	   (vl-registry-read C3D "Release")
	    C3D	   (substr
		     C3D
		     1
		     (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
		   )
	    C3D	   (vla-getinterfaceobject
		     (vlax-get-acad-object)
		     (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
		   )
	    C3Ddoc (vla-get-activedocument C3D))
    (progn
      (setq ntwrks (vlax-get c3ddoc 'Pipenetworks))     
      (setq ZM2OBJ (LM:select-or-text "\nSelect Profile View Struture or Pipe to zoom to: " '((0 . "AECC_GRAPH_PROFILE_NETWORK_PART"))))
      (setq OBJNAME (if (= (TYPE ZM2OBJ) 'STR) ZM2OBJ (vla-get-name (vlax-ename->vla-object ZM2OBJ))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;(ai_tiledvp 2 "_V") ;; Creates Two Views within Modelspace.


;;Within layout paperspace viewport (Already Created),  <<<-------
;;Select the object, then create a new viewport  <<<-------
;;within the same layout which zooms the selected object.  <<<-------

(initget 1)
(setq VP1 (getpoint "\nSelect First Corner of Viewport: "))
(princ VP1)
(initget 1)
(setq VP2 (getcorner VP1 "\nSelect Second Corner of Viewport: "))
(princ VP2)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


      (vlax-for	ntwrk ntwrks
	(if (not obj)
	  (progn
	    (vl-catch-all-apply
	      '(lambda ()
		 (setq structures (vlax-get ntwrk 'structures))
		 (setq obj (vlax-invoke structures 'item OBJNAME))
	       )
	      '()
	    )
	    (if (not obj)
	    (vl-catch-all-apply
	      '(lambda ()
		 (setq Pipes (vlax-get ntwrk 'Pipes))
		 (setq obj (vlax-invoke Pipes 'item OBJNAME))
	       )
	      '()
	    )
	    );if
	  )
	)
      )
      (cond
	((not obj)
	  (princ (strcat "\nStructure \"" OBJNAME "\" not found."))
	)
	((= (vla-get-objectname obj) "AeccDbStructure")
	  (setq location (vlax-get obj 'position))
	  (setq PointAtParam0 (list (vlax-get location 'x) (vlax-get location 'y)))
	  (command "zoom" "c" PointAtParam0 "50")
	)
	((= (vla-get-objectname obj) "AeccDbPipe")
	  (setq PointAtParam0 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'PointAtParam 0))))
	  (setq PointAtParam1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'PointAtParam 1))))
	  (command "zoom" "w" PointAtParam0 PointAtParam1)
	  ;;(vla-highlight obj T)
	)
	(T
	  (princ (strcat "\nPipe \"" OBJNAME "\" not found."))
	)
      )
    )
  )
(*error* nil)
(princ))

 

[BIGAL]

Civil site design has the option of adding the corresponding plan view to a long section, this is all done automatically for the length of the chosen alignment so can end up with multiple layouts created automatically. It follows the alignment so layouts will be twisted etc.

 

[rcb007]

Thanks for sharing. I do not think i have heard about this package.

[BIGAL]

It has a long history here in Australia started as Civilcad. like 40 years ago. I am a ex State manager for Civilcad so I am biased towards it. I am retired but where used to work we used it every day with multiple designers.

 

https://civilsitedesign.com.au/

 

Over at Bricscad world there is a fantastic demonstration of how to do a main road, connecting car park, kerb returns and so much more. Will try to find.

Edited April 8, 2023 by BIGAL

[hosneyalaa]

@rcb007

hi

try

 

(defun c:ZTPS (/ C3D C3DDOC LOCATION NTWRK NTWRKS PROD PRODSTR PointAtParam0 PointAtParam1 OBJ OBJNAME STRUCTURES ZM2OBJ VP1 VP2)
  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))))
  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))))
  (vl-load-com)
  (if (setq C3D	   (strcat "HKEY_LOCAL_MACHINE\\"
			   (if vlax-user-product-key
			     (vlax-user-product-key)
			     (vlax-product-key)
			   )
		   )
	    C3D	   (vl-registry-read C3D "Release")
	    C3D	   (substr
		     C3D
		     1
		     (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
		   )
	    C3D	   (vla-getinterfaceobject
		     (vlax-get-acad-object)
		     (strcat "AeccXUiPipe.AeccPipeApplication." C3D)
		   )
	    C3Ddoc (vla-get-activedocument C3D))
    (progn
      (setq ntwrks (vlax-get c3ddoc 'Pipenetworks))     
     ; (setq ZM2OBJ (LM:select-or-text "\nSelect Profile View Struture or Pipe to zoom to: " '((0 . "AECC_GRAPH_PROFILE_NETWORK_PART"))))
      (setq ZM2OBJ (car (entsel "\nSelect" )) )
      (setq OBJNAME (if (= (TYPE ZM2OBJ) 'STR) ZM2OBJ (vla-get-name (vlax-ename->vla-object ZM2OBJ))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;(ai_tiledvp 2 "_V") ;; Creates Two Views within Modelspace.


;;Within layout paperspace viewport (Already Created),  <<<-------
;;Select the object, then create a new viewport  <<<-------
;;within the same layout which zooms the selected object.  <<<-------

(initget 1)
(setq VP1 (getpoint "\nSelect First Corner of Viewport: "))
(princ VP1)
(initget 1)
(setq VP2 (getcorner VP1 "\nSelect Second Corner of Viewport: "))
(princ VP2)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


      (vlax-for	ntwrk ntwrks
	(if (not obj)
	  (progn
	    (vl-catch-all-apply
	      '(lambda ()
		 (setq structures (vlax-get ntwrk 'structures))
		 (setq obj (vlax-invoke structures 'item OBJNAME))
	       )
	      '()
	    )
	    (if (not obj)
	    (vl-catch-all-apply
	      '(lambda ()
		 (setq Pipes (vlax-get ntwrk 'Pipes))
		 (setq obj (vlax-invoke Pipes 'item OBJNAME))
	       )
	      '()
	    )
	    );if
	  )
	)
      )
      (cond
	((not obj)
	  (princ (strcat "\nStructure \"" OBJNAME "\" not found."))
	)
	((= (vla-get-objectname obj) "AeccDbStructure")
	  (setq location (vlax-get obj 'position))
	  (setq PointAtParam0 (list (vlax-get location 'x) (vlax-get location 'y)))
	  (command "zoom" "c" PointAtParam0 "50")
	)
	((= (vla-get-objectname obj) "AeccDbPipe")
	  (setq PointAtParam0 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'PointAtParam 0))))
	  (setq PointAtParam1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'PointAtParam 1))))
	  (command "zoom" "w" PointAtParam0 PointAtParam1)
	  ;;(vla-highlight obj T)
	)
	(T
	  (princ (strcat "\nPipe \"" OBJNAME "\" not found."))
	)
      )
    )
  )
(*error* nil)
(princ))