Lisp Review and Feedback

January 23, 2022

Hello,

The intend of this modified lisp is to iterate through the viewports in layout, get inside, change dimension according to viewport scale.

So far this is where I'm:

;;;---------------------------------------------------------------------------;
;;;
;;; vpsel.lsp
;;;
;;; By Jimmy Bergmark
;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;;
;;; 2000-04-14 - First release
;;; Tested on AutoCAD 2000
;;;
;;;---------------------------------------------------------------------------;
;;;  DESCRIPTION
;;;
;;;  Select all visible objects in selected or active paperspace viewport
;;;  Works transparently when in modelspace and for polygonal viewports too
;;;  Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible
;;;  Example2: (command "erase" "all" "r" (c:vpc) "")
;;;  Example3: VPC ERASE >>> VPC is run previous the command and the objects
;;;                            are also in previous selection set
;;;
;;;  c:vpc - select all visible objects with crossing in viewport
;;;  c:vpw - select all visible objects with window in viewport
;;;---------------------------------------------------------------------------;

(defun c:vpttt ()
  (vpselttt "C")
  (princ)
  (command "_SELECT" "ALL" "")
  (Command "_.PSPACE")
 
)

(defun c:vpwttt ()
  (vpselttt "W")
  (princ)
)

(defun dxf (n ed) (cdr (assoc n ed)))

(defun vpselttt (typ   /     ad    ss    ent   vpno  ok    vpbl  vpur
              msbl  msur  msul  mslr  ss1   pl    nlist x     n
             )
  (vl-load-com)
  (setq ok t)
  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
        (if (and (= (getvar "cmdactive") 0)
                (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) 
            )
          (progn
            (setq ent (ssname ss Vindex))
            (setq vpno (dxf 69 (entget ent)))
            (vla-Display (vla-get-activepviewport ad) :vlax-true)
            (vla-put-mspace ad :vlax-true)
            (setvar "cvport" vpno)
          )
          (progn
            (setq ok nil)
          )
        )
        (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
        (progn
          (if (= (vla-get-clipped (vlax-ename->vla-object ent))
                 :vlax-false
              )
            (progn
              (vla-getboundingbox
                (vla-get-activepviewport ad)
                'vpbl
                'vpur
              )
              (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
              (setq msur (trans (vlax-safearray->list vpur) 3 2))
              (setq msul (list (car msbl) (cadr msur)))
              (setq mslr (list (car msur) (cadr msbl)))
              (setq ss1
                     (ssget (strcat typ "P") (list msbl msul msur mslr))
              )
            )
;;;           (progn
;;;              (setq pl (entget (dxf 340 (entget ent))))
;;;              (setq nlist nil)
;;;              (foreach x pl
;;;                (if (eq 10 (car x))
;;;                  (setq nlist (cons (trans (cdr x) 3 2) nlist))
;;;                )
;;;              )
;;;              (setq ss1 (ssget (strcat typ "P") nlist))
;;;            )
          )
          (sssetfirst nil ss1)
          (if ss1
            (setq n (sslength ss1))
            (setq n 0)
          )
          (princ n)
          (princ " found ")
          (if (and ss1 (= (getvar "cmdactive") 1))
            ss1
          )
        )
      )
    )
  )
;;;  (setq ss nil ss1 nil)
(setq data ss1)
(setq cscale (vla-get-CustomScale (vlax-ename->vla-object (ssname ss 2))))
  (if (=  cscale 0.005)
    (Progn
(setq i 0)
(repeat	(sslength data)
  (setq e (ssname data i))
  (if
    (and (< i (sslength data))
	   (equal "DIMENSION" (cdr (assoc 0 (entget e))))
      )

(progn
    (setq entdimnstyle (entget e))
    (setq newdim (subst	(cons 3 "Dimension 200")
			(assoc 3 entdimnstyle)
			entdimnstyle
		 )
	  )
	  (entmod newdim)
 (setq i (1+ i))
  )
 )  
)
)
    )
(if (=  cscale 0.0100)
   

(repeat	(sslength data)
  (setq e (ssname data i))
  (if
    (and (< i (sslength data))
	   (equal "DIMENSION" (cdr (assoc 0 (entget e))))
      )

(progn
    (setq entdimnstyle (entget e))
    (setq newdim (subst	(cons 3 "Dimension 100")
			(assoc 3 entdimnstyle)
			entdimnstyle
		 )
	  )
	  (entmod newdim)
 (setq i (1+ i))
  )
 )  
   

 (setq i (1+ i))

)
)
 (setq i (1+ i))




  )

(princ)

I need a repeat command I believe, but if I insert repeat from above this line: (setq ent (ssname ss Vindex)) and close it at the end I don't keep information stored in this line: (setq data ss1)

Please guide me through this problem...

Thank you

January 23, 2022

It is the same lisp, can you keep 1 thread about it?

I think you got to restructure the lisp, break it downs to some levels, each function do some specific thing

then it will easier to debug

(defun get_objects_in_viewport (viewport /)
   ... the hard code goes here ...
   ss ;return the selectionset
)
;------------------------------------------
(defun change_dimension_accordingly (viewport /)
   (setq ss (get_objects_in_viewport viewport))
   ... do the changing code here ...
)
;------------------------------------------
(defun C:maincommand (/ *error*)
   (defun *error* (msg)
     (princ msg) ;or do something here ...
   )
   (setq allviewports (ssget ...))
   
   (... loop through allviewports ...
      >>> (change_dimension_accordingly viewport)
   )
   (princ)
)

January 23, 2022

So a couple of things I noticed , the line you want to repeat from is inside your 3rd 'If' command, then that 'if' is finished and later you define what ss1 is... so that shouldn't affect anything (hoping I have read this right). If you are meaning your 'repeat' loop to do more than after the line (setvar "cvport" vpno) then I think you need to look at where the 'if' and 'progn' opening and closing brackets are.

Also noticed that near the end, after this 'if' (if (= cscale 0.005) you define (setq i 0), but after the (if (= cscale 0.0100) you don't.. do you need to add that in there?

For my first comment, I often find it handy to number my ifs, whiles, repeats as I go, keeping tabs on where you are... something like this@
Wonder if that helps at all

(defun c:vpttt ()
  (vpselttt "C")
  (princ)
  (command "_SELECT" "ALL" "")
  (Command "_.PSPACE")
 
)

(defun c:vpwttt ()
  (vpselttt "W")
  (princ)
)

(defun dxf (n ed)
  (cdr (assoc n ed))
)

(defun vpselttt (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x  n)
  (vl-load-com)
  (setq ok t)
  (if (= (getvar "tilemode") 0) ;;if 1
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1) ;;if 2
        (if (and (= (getvar "cmdactive") 0) (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) ) ;;if 3
          (progn
            (setq ent (ssname ss Vindex))

;;SUGGESTED REPEAT HERE

            (setq vpno (dxf 69 (entget ent)))
            (vla-Display (vla-get-activepviewport ad) :vlax-true)
            (vla-put-mspace ad :vlax-true)
            (setvar "cvport" vpno)

;;SUGGESTED REPEAT SHOULD END BY HERE

          )
          (progn
            (setq ok nil)
          )
        ) ;;end if 3
        (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      ) ;;end if 2
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) ;;if 4
        (progn
          (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) ;;if 5
            (progn
              (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur )
              (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
              (setq msur (trans (vlax-safearray->list vpur) 3 2))
              (setq msul (list (car msbl) (cadr msur)))
              (setq mslr (list (car msur) (cadr msbl)))
              (setq ss1  (ssget (strcat typ "P") (list msbl msul msur mslr)))
            )
          ) ;;end if 5
          (sssetfirst nil ss1)
          (if ss1 ;;if 6
            (setq n (sslength ss1))
            (setq n 0)
          )
          (princ n)
          (princ " found ")
          (if (and ss1 (= (getvar "cmdactive") 1)) ;;if 7
            ss1
          )
        )
      ) ;;end if 4
    )
  ) ;;end if 1
;;;  (setq ss nil ss1 nil)

  (setq data ss1)
  (setq cscale (vla-get-CustomScale (vlax-ename->vla-object (ssname ss 2))))
  (if (=  cscale 0.005) ;;if 8
    (Progn
      (setq i 0)
      (repeat (sslength data)
        (setq e (ssname data i))
        (if (and (< i (sslength data))(equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) ;;if 9
          (progn
            (setq entdimnstyle (entget e))
            (setq newdim (subst (cons 3 "Dimension 200") (assoc 3 entdimnstyle) entdimnstyle ))
            (entmod newdim)
            (setq i (1+ i))
          )
        )  ;;end if 9
      ) ;;end repeat
    )
  ) ;;end if 8
  (if (= cscale 0.0100) ;;if 10
    (repeat (sslength data)
      (setq e (ssname data i))
      (if (and (< i (sslength data))(equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) ;;if 11
        (progn
          (setq entdimnstyle (entget e))
          (setq newdim (subst (cons 3 "Dimension 100")(assoc 3 entdimnstyle) entdimnstyle))
	  (entmod newdim)
          (setq i (1+ i))
        )
      )  ;;end if 11
      (setq i (1+ i))
    ) ;;end repeat
  ) ;;end if 10
  (setq i (1+ i))
)

January 23, 2022

Hello,

This is the updated code followed by your advises: Everything runs smoothly, but nothing happens:)

I tried to follow them. This dude (setq ss (get_objects_in_viewport viewport)) gives me number 3, however I need selection set.

A bonus question: my index variable has to be a different one in functions or I can reuse it.

Please help.

Steven P, everything helps:)

Thank you

(defun dxf (n ed) (cdr (assoc n ed)))
(defun get_objects_in_viewport (viewport /)

  (vl-load-com)
  (setq ok t)
  (setq index 0)
  (repeat (sslength allviewports)
  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
	(if (and (= (getvar "cmdactive") 0)
		 (setq ss (ssget "_x" (list '(0 . "VIEWPORT"))))
	    )
	 
	  (progn
	    (setq ent (ssname allviewports index))
	    (setq vpno (dxf 69 (entget ent)))
	    (vla-Display (vla-get-activepviewport ad) :vlax-true)
	    (vla-put-mspace ad :vlax-true)
	    (setvar "cvport" vpno)
	  )
	  (progn
	    (setq ok nil)
	  )
	)
	(setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
	(progn
	  (if (= (vla-get-clipped (vlax-ename->vla-object ent))
		 :vlax-false
	      )
	    (progn
	      (vla-getboundingbox
		(vla-get-activepviewport ad)
		'vpbl
		'vpur
	      )
	      (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
	      (setq msur (trans (vlax-safearray->list vpur) 3 2))
	      (setq msul (list (car msbl) (cadr msur)))
	      (setq mslr (list (car msur) (cadr msbl)))
	      (setq ss1
		     (ssget (strcat "C" "P") (list msbl msul msur mslr))
	      )
	    )

	  )
	  (sssetfirst nil ss1)
	  (if ss1
	    (setq n (sslength ss1))
	    (setq n 0)
	  )
	  (princ n)
	  (princ " found ")
	  (if (and ss1 (= (getvar "cmdactive") 1))
	    ss1
	  )
	)
      )
    )
  )

;;;  (setq data ss1)
(setq index (+ 1 index))					
)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;(setq info (get_objects_in_viewport viewport))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun change_dimension_accordingly (viewport /)


  (setq ss (get_objects_in_viewport viewport))
   
(setq cscale (vla-get-CustomScale (vlax-ename->vla-object viewport )))
  (if (=  cscale 0.005)
    (Progn
(setq index3 0)
(repeat	(sslength ss1)
  (setq e (ssname ss1 index3))
  (if
    (and (< i (sslength ss1))
	   (equal "DIMENSION" (cdr (assoc 0 (entget e))))
      )

(progn
    (setq entdimnstyle (entget e))
    (setq newdim (subst	(cons 3 "Dim 200")
			(assoc 3 entdimnstyle)
			entdimnstyle
		 )
	  )
	  (entmod newdim)
 (setq i (1+ i))
  )
 )  
)
)
    )
(if (=  cscale 0.0100)
   

(repeat	(sslength ss1)
  (setq e (ssname ss1 i))
  (if
    (and (< i (sslength ss1))
	   (equal "DIMENSION" (cdr (assoc 0 (entget e))))
      )

(progn
    (setq entdimnstyle (entget e))
    (setq newdim (subst	(cons 3 "Dim 100")
			(assoc 3 entdimnstyle)
			entdimnstyle
		 )
	  )
	  (entmod newdim)
 (setq i (1+ i))
  )
 )  
   

 (setq i (1+ i))

)
)
 (setq index3 (1+ index3))




  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:maincommand (/ *error*)
;;;   (defun *error* (msg)
;;;     (princ msg) ;or do something here ...
;;;   )
   (setq allviewports (ssget "_x" (list '(0 . "VIEWPORT"))))
   
   (setq index2 0)
  (repeat (sslength allviewports)
    (setq viewport (ssname allviewports index2))
	  
      (change_dimension_accordingly viewport)
    (setq index2 (+ 1 index2))
   )
   (princ)
;;;  (command "_SELECT" "ALL" "")
;;;  (Command "_.PSPACE")
)

January 24, 2022

"(defun get_objects_in_viewport (viewport /) ..." is to deal with the given viewport

It helps you to move the loop through all viewports routine out to the main routine.

But why still in that (defun get_objects_in_viewport (viewport /) you have code to select all viewport and repeat sslength?

January 24, 2022

I have to take a bit easy the Autolisp. To get this working I need a week lets say. Why am I rushed to get it? , till the point I can't eat and sleep+anxiety.

January 25, 2022

Good morning,

This is updated code:

Please check overall syntax of "change_dimension_accordingly" function

(defun dxf (n ed) (cdr (assoc n ed)))
(defun get_objects_in_viewport (viewport /)

  (vl-load-com)
  (setq ok t)


  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
	(if (and (= (getvar "cmdactive") 0)
		 (setq ss (ssget "_x" (list '(0 . "VIEWPORT"))))
	    )
	 
	  (progn
	    (setq ent (ssname ss index))
	    (setq vpno (dxf 69 (entget ent)))
	    (vla-Display (vla-get-activepviewport ad) :vlax-true)
	    (vla-put-mspace ad :vlax-true)
	    (setvar "cvport" vpno)
	  )
	  (progn
	    (setq ok nil)
	  )
	)
	(setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
	(progn
	  (if (= (vla-get-clipped (vlax-ename->vla-object ent))
		 :vlax-false
	      )
	    (progn
	      (vla-getboundingbox
		(vla-get-activepviewport ad)
		'vpbl
		'vpur
	      )
	      (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
	      (setq msur (trans (vlax-safearray->list vpur) 3 2))
	      (setq msul (list (car msbl) (cadr msur)))
	      (setq mslr (list (car msur) (cadr msbl)))
	      (setq ss1
		     (ssget (strcat "C" "P") (list msbl msul msur mslr))
	      )
	    )

	  )
	  (sssetfirst nil ss1)
	  (if ss1
	    (setq n (sslength ss1))
	    (setq n 0)
	  )
	  (princ n)
	  (princ " found ")
	  (if (and ss1 (= (getvar "cmdactive") 1))
	    ss1
	  )
	)
      )
    )
  )

  (setq data ss1)
					

  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;(setq info (get_objects_in_viewport viewport))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun change_dimension_accordingly (viewport /)


 (setq Obj_index 0)
  
(setq info (get_objects_in_viewport viewport))
 
 (while (<= Obj_index (sslength info))
   
    (cond
      (if
       (and (= 0.005
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )


      (progn
       (setq index_Dim_200 0)
       (repeat (sslength info)

	 (setq entdimnstyle (entget e))
	 (setq newdim200 (subst (cons 3 "Dim 200")
			     (assoc 3 entdimnstyle)
			     entdimnstyle
		      )
	 )
	 (entmod newdim200)
	 (setq index_Dim_200 (1+ index_Dim_200))

       )
      )
    )
 (cond
   (if
       (and (= 0.01
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )
	  (Progn
	    (setq index_Dim_100 0)
	    (repeat (sslength info)

	      (setq entdimnstyle (entget e))
	      (setq newdim100 (subst (cons 3 "Dim 100")
				  (assoc 3 entdimnstyle)
				  entdimnstyle
			   )
	      )
	      (entmod newdim100)
	      (setq index_Dim_100 (1+ index_Dim_100))
	    )
	  
)
	 
  )     

    (setq Obj_index ( + 1  Obj_index))
    )
  )







   


  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:maincommand (/ *error*)
;;;   (defun *error* (msg)
;;;     (princ msg) ;or do something here ...
;;;   )
   (setq allviewports (ssget "_x" (list '(0 . "VIEWPORT"))))
   
   (setq index2 0)
  (repeat (sslength allviewports)
    (setq viewport (ssname allviewports index2))
	  
      (change_dimension_accordingly viewport)
    (setq index2 (+ 1 index2))
   )
   (princ)
;;;  (command "_SELECT" "ALL" "")
;;;  (Command "_.PSPACE")
)

this line

(ssname info Obj_index)

gives me error on the last index, I wonder why, please see the image above

Edited January 25, 2022 by nzoro99

January 25, 2022

Now it doesn't switch to other viewport. It changes the dimensions only in one viewport , but doesn't assign the right scale.

Code updated:

(defun dxf (n ed) (cdr (assoc n ed)))
(defun get_objects_in_viewport (viewport /)

  (vl-load-com)
  (setq ok t)


  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
	(if (and (= (getvar "cmdactive") 0)
		 (setq ss (ssget "_x" (list '(0 . "VIEWPORT"))))
	    )
	 
	  (progn
	    (setq ent (ssname ss index))
	    (setq vpno (dxf 69 (entget ent)))
	    (vla-Display (vla-get-activepviewport ad) :vlax-true)
	    (vla-put-mspace ad :vlax-true)
	    (setvar "cvport" vpno)
	  )
	  (progn
	    (setq ok nil)
	  )
	)
	(setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
	(progn
	  (if (= (vla-get-clipped (vlax-ename->vla-object ent))
		 :vlax-false
	      )
	    (progn
	      (vla-getboundingbox
		(vla-get-activepviewport ad)
		'vpbl
		'vpur
	      )
	      (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
	      (setq msur (trans (vlax-safearray->list vpur) 3 2))
	      (setq msul (list (car msbl) (cadr msur)))
	      (setq mslr (list (car msur) (cadr msbl)))
	      (setq ss1
		     (ssget (strcat "C" "P") (list msbl msul msur mslr))
	      )
	    )

	  )
	  (sssetfirst nil ss1)
	  (if ss1
	    (setq n (sslength ss1))
	    (setq n 0)
	  )
	  (princ n)
	  (princ " found ")
	  (if (and ss1 (= (getvar "cmdactive") 1))
	    ss1
	  )
	)
      )
    )
  )

  (setq data ss1)
					

  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;(setq info (get_objects_in_viewport viewport))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun change_dimension_accordingly (viewport /)


 (setq Obj_index 0)
  
(setq info (get_objects_in_viewport viewport))
   (repeat (sslength info)
 
   
    (cond
     
     ((if (= 0.005
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
       (and
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )

(progn
      
       (setq index_Dim_200 0)
       

	 (setq entdimnstyle (entget (ssname info Obj_index)))
	 (setq newdim200 (subst (cons 3 "Dim 200")
			     (assoc 3 entdimnstyle)
			     entdimnstyle
		      )
	 )
	 (entmod newdim200)
	 (setq index_Dim_200 (1+ index_Dim_200))

       
      )
    )
    
      )
 (cond
    
   ((if
      (= 0.01
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
      (and
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )
	  (Progn
	    (setq index_Dim_100 0)
	    

	      (setq entdimnstyle (entget (ssname info Obj_index)))
	      (setq newdim100 (subst (cons 3 "Dim 100")
				  (assoc 3 entdimnstyle)
				  entdimnstyle
			   )
	      )
	      (entmod newdim100)
	      (setq index_Dim_100 (1+ index_Dim_100))
	    )
	  

	 
  )     
)
 
     (if  (< Obj_index (- (sslength info) 1 )) 
    (setq Obj_index(+ 1 Obj_index)) 
    )
 

)
)




   


  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:maincommand (/ *error*)
;;;   (defun *error* (msg)
;;;     (princ msg) ;or do something here ...
;;;   )
   (setq allviewports (ssget "_x" (list '(0 . "VIEWPORT"))))
   
   (setq index2 0)
  (repeat (sslength allviewports)
    (setq viewport (ssname allviewports index2))
	  
      (change_dimension_accordingly viewport)
    (setq index2 (+ 1 index2))
   )
   (princ)
;;;  (command "_SELECT" "ALL" "")
;;;  (Command "_.PSPACE")
)

Edited January 25, 2022 by nzoro99

February 5, 2022

5th February:)

Hello forum,

I'm still on this section of a longer Lisp. (this section is modified VPSEL function found on web)

I would like to iterate through viewports in layout and change the dimensions accordingly to scale of the viewport.

I get the point where dimensions are changing NOT "Accordingly", but still the change happens , viewport remains active ...but it doesn't switch to other viewports to continue the process.

Can't say I'm exhausted by trying to find solution, but still....basically looking for even more help..

(defun dxf (n ed) (cdr (assoc n ed)))
(defun get_objects_in_viewport (viewport /)

  (vl-load-com)



  (if (= (getvar "tilemode") 0)
    (progn
      (setq ad (vla-get-activedocument (vlax-get-acad-object)))
      (if (= (getvar "cvport") 1)
	(if (and (= (getvar "cmdactive") 0)
		 (setq ss (ssget "_x" (list '(0 . "VIEWPORT"))))
	    )
	 
	  (progn
	    
	    (setq vpno (dxf 69 (entget viewport)))
	    (vla-Display (vla-get-activepviewport ad) :vlax-true)
	    (vla-put-mspace ad :vlax-true)
	    (setvar "cvport" vpno)
	  )
	  
	)
	(setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))
      )
      (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
	(progn
	  (if (= (vla-get-clipped (vlax-ename->vla-object ent))
		 :vlax-false
	      )
	    (progn
	      (vla-getboundingbox
		(vla-get-activepviewport ad)
		'vpbl
		'vpur
	      )
	      (setq msbl (trans (vlax-safearray->list vpbl) 3 2))
	      (setq msur (trans (vlax-safearray->list vpur) 3 2))
	      (setq msul (list (car msbl) (cadr msur)))
	      (setq mslr (list (car msur) (cadr msbl)))
	      (setq ss1
		     (ssget (strcat "C" "P") (list msbl msul msur mslr))
	      )
	    )

	  )
	  (sssetfirst nil ss1)
	  (if ss1
	    (setq n (sslength ss1))
	    (setq n 0)
	  )
	  (princ n)
	  (princ " found ")
	  (if (and ss1 (= (getvar "cmdactive") 1))
	    ss1
	  )
	)
      )
    )
  )

  (setq data ss1)
					

  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;(setq info (get_objects_in_viewport viewport))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun change_dimension_accordingly (viewport /)


 (setq Obj_index 0)
  
(setq info (get_objects_in_viewport viewport))
   (repeat (sslength info)
 
   
    (cond
     
     ((if (= 0.005
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
       (and
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )

(progn
      
       (setq index_Dim_200 0)
       

	 (setq entdimnstyle (entget (ssname info Obj_index)))
	 (setq newdim200 (subst (cons 3 "Dim 200")
			     (assoc 3 entdimnstyle)
			     entdimnstyle
		      )
	 )
	 (entmod newdim200)
	 (setq index_Dim_200 (1+ index_Dim_200))

       
      )
    )
    
      )
 (cond
    
   ((if
      (= 0.01
	       (vla-get-CustomScale (vlax-ename->vla-object viewport))
	    )
      (and
	    (equal "DIMENSION"
		   (cdr (assoc 0 (entget (ssname info Obj_index))))
	    )
       )
      )
	  (Progn
	    (setq index_Dim_100 0)
	    

	      (setq entdimnstyle (entget (ssname info Obj_index)))
	      (setq newdim100 (subst (cons 3 "Dim 100")
				  (assoc 3 entdimnstyle)
				  entdimnstyle
			   )
	      )
	      (entmod newdim100)
	      (setq index_Dim_100 (1+ index_Dim_100))
	    )
	  

	 
  )     
)
 
     (if  (< Obj_index (- (sslength info) 1 )) 
    (setq Obj_index(+ 1 Obj_index)) 
    )
 

)
)




   


  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:maincommand (/ *error*)
;;;   (defun *error* (msg)
;;;     (princ msg) ;or do something here ...
;;;   )
   (setq allviewports (ssget "_x" (list '(0 . "VIEWPORT"))))
   
   (setq index2 0)
  (repeat (sslength allviewports)
    (setq viewport (ssname allviewports index2))
	  
      (change_dimension_accordingly viewport)
    (setq index2 (+ 1 index2))
   )
   (princ)
;;;  (command "_SELECT" "ALL" "")
;;;  (Command "_.PSPACE")
)

Thank you!

Sign In

Lisp Review and Feedback

Recommended Posts

nzoro99

Linh

Steven P

nzoro99

Linh

nzoro99

nzoro99

nzoro99

nzoro99

Join the conversation

Tutorials

Forums

Activity