help to improve routine viewport scale

[leonucadomi]

hello all:

I am using this magnificent routine

 

makes a list of all viewports and its scales.

and sends a warning if there is a wrong scale.

 

I would like the windows with the wrong scales to be painted red

to detect them quickly.

 

Can somebody help me?

here code

;escalas de todos los viewports

(defun c:evp2 ( / ssvp tel ss_ent vlag entlijst hoogte xlijst xhoogte antw
i_sch vp_id vlagx vp_test)

(command "zoom" 1xp) ; undo

(setq ssvp (ssget "X" '((0 . "VIEWPORT"))) tel 0 ss_ent nil)

(while (< tel (sslength ssvp))

(setq ss_ent (cons (ssname ssvp tel) ss_ent) tel (1+ tel))

);while

(if (cdr ss_ent)(setq ss_ent (cdr ss_ent)))
(setq ssvp nil vlag nil vlagx nil)

(foreach n ss_ent

(setq entlijst (entget n '("*")))

(setq hoogte (cdr (assoc 41 entlijst))
vp_id (cdr (assoc 69 entlijst))
xlijst (cadr (assoc -3 entlijst)))
(setq xhoogte (cdr (nth 7 xlijst)))

(cond
((> xhoogte hoogte)
(setq antw (rem xhoogte hoogte)
i_sch (/ xhoogte hoogte)))
(T
(setq antw (rem hoogte xhoogte)
i_sch (/ 1000 (/ hoogte xhoogte))))
);cond

(setq vp_test (rem i_sch (fix i_sch)))
(if (> vp_test 0.5)(setq vp_test (1- vp_test)))
(if (not (equal vp_test 0.0 0.00001))(setq vlag 1 vlagx 1))

(if (= vlagx 1)
(princ (strcat "\nViewport " (itoa (1- vp_id)) " is scale 1:" (rtos
i_sch 2 8)))
(princ (strcat "\nViewport " (itoa (1- vp_id)) " is scale 1:" (rtos
i_sch 2 0)))
)
(princ "\n ")
(setq vlagx nil)

);foreach

(if vlag (alert "One or more viewports have got a wrong scale !"))
(princ)

);defun

 

[BIGAL]

My $0.05

 

Did you use chatGP for code ?

 

(defun c:evp2 ( / ssvp tel sc vlag obj)
(setq ssvp (ssget "X" '((0 . "VIEWPORT"))))
(if (= ssvp nil)(progn (alert "NO viewports selected \n \nWill exit now ")(exit)))

(repeat (setq tel (sslength ssvp))
  (setq obj (vlax-ename->vla-object (ssname ssvp (setq tel (1- tel)))))
  (setq sc (vlax-get obj 'customscale))
  (cond
     ((equal sc 1.0 1e-03)(setq vlag 0))
     ((equal sc 10.0 1e-03)(setq vlag 0))
     ((equal sc 5.0 1e-03)(setq vlag 0))
     ((equal sc 50.0 1e-03)(setq vlag 0))
     ((setq vlag 1))
  )
  (if (= vlag 1)
  (progn
   (vlax-put obj 'color 1)
   (alert "One or more viewports have got a wrong scale ! \n \nNow RED color ")
   (setq vlag nil)
  )
  )
)

(princ)

)
(c:evp2 )

 

[mhupp]

like to convert everything into vla-object from the selection set by using the foreach and "(mapcar 'vlax-ename->vla-object"

 

(defun c:evp2 (/ ssvp sc vlag)
  (if (setq ssvp (ssget "X" '((0 . "VIEWPORT"))))
    (foreach obj (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex sssvp)))
      (setq sc (vlax-get obj 'customscale))
      (cond
        ((equal sc 1.0 1e-03)(setq vlag 0))
        ((equal sc 10.0 1e-03)(setq vlag 0))
        ((equal sc 5.0 1e-03)(setq vlag 0))
        ((equal sc 50.0 1e-03)(setq vlag 0))
        ((setq vlag 1))
      )
      (if (= vlag 1)
        (progn
          (vlax-put obj 'color 1)
          (prompt "\nViewport has wrong scale!")  ;will process all viewports and not stop waiting for user to click ok
          (setq vlag nil)
        )
      )
    )
    (alert "NO viewports selected \n \nWill exit now")
  )
  (princ)
)

 

If it displays your View ports have errors should probably have a lisp to go to the tab with the error.

;;------------------------------------------------------------------;;
;; Fine View port
(defun c:FVP (/ ssvp)
  (if (setq ssvp (ssget "X" '((0 . "VIEWPORT") (62 . 1))))
    (progn
      (setvar 'ctab (cdr (assoc 410 (entget (ssname ssvp 0))))) ;go to tab with the first viewport found
      (prompt (starcat "\n" (rtos (sslength ssvp) 2 0) "Viewports need to be Checked"))
    )
    (prompt "\nDidn't fine any Viewports with error's")
  )
  (princ)
)

updated code

 

Edited December 6, 2023 by mhupp

[BIGAL]

"If it displays your View ports have errors should probably have a lisp to go to the tab with the error." Good idea,  I set up 3 layouts with multi viewports for testing.