Viewport+Entmod !

Antonio Ribeiro · November 2008

Hi all!I have a lisp that scale a selected viewport in fonction of the drawing scale. It worked well in V7. Now I'm on V8. I tried it, but Scale doesn't change. It seems the entmod-entupd codes doesn't work on viewports !Perhaps great new polygonal viewports tool is responsible ?here is the code.... Sorry this code is very old ! ^^

(defun C:vpscale (/ a refi aa quest divi resul peti gran)    (if (eq (getvar "tilemode") 0)        (progn            (if (getenv "echPresentation")                (setq l1 (getenv "echPresentation"))                (progn                    (setenv "echPresentation" "M")                    (setq l1 (getenv "echPresentation"))                )            )            (setq quest (strcase (getstring T (strcat "\nUnité du dessin [Mètre (m)/CentiMètres (cm)/MilliMètres (mm)] <" l1 "> : "))))            (if (eq quest "") (setq quest l1))            (setenv "echPresentation" quest)            (if (or (eq quest "M")(eq quest "CM")(eq quest "MM"))                (progn                    (if (eq quest "M")                        (setq divi 1000)                        (if (eq quest "CM")                            (setq divi 10)                            (if (eq quest "MM")                                (setq divi 1)                            )                        )                    )                    (listzoomxp)                    (while                         (or                            (not (setq aa (car (entsel "\nSélectionner la fenêtre d'impression : "))))                            (if (/= (cdr (assoc 0 (entget aa))) "VIEWPORT")                                (princ "\nL'objet sélectionné n'est de type VIEWPORT...")                            )                        )                    )                    (if aa                        (progn                            (setq                                 entaa (entget aa)                                aa41  (cdr (assoc 41 entaa))                                aa45  (cdr (assoc 45 entaa))                                aaz   (/ aa41 aa45)                                aazz  (/ aaz divi)                            )                            (if (eq quest "M")                                (foreach pt listxp                                    (if (eq (cadddr pt) aaz)                                        (setq resul (car pt))                                        (if (and (<= (cadddr pt) aaz)(>= (cadddr pt) peti))                                            (setq peti (cadddr pt) petit (car pt))                                            (if (>= (cadddr pt) aaz)                                                (setq gran (cadddr pt) grand (car pt))                                                (if (and (>= (cadddr pt) aaz)(<= (cadddr pt) peti))                                                    (setq gran (cadddr pt) grand (car pt))                                )))))                                (if (eq quest "CM")                                    (foreach pt listxp                                        (if (eq (caddr pt) aaz)                                            (setq resul (car pt))                                            (if (and (<= (caddr pt) aaz)(>= (caddr pt) peti))                                                (setq peti (caddr pt) petit (car pt))                                                (if (>= (caddr pt) aaz)                                                    (setq gran (caddr pt) grand (car pt))                                                    (if (and (>= (caddr pt) aaz)(<= (caddr pt) peti))                                                        (setq gran (caddr pt) grand (car pt))                                    )))))                                    (if (eq quest "MM")                                        (foreach pt listxp                                            (if (eq (cadr pt) aaz)                                                (setq resul (car pt))                                                (if (and (<= (cadr pt) aaz)(>= (cadr pt) peti))                                                    (setq peti (cadr pt) petit (car pt))                                                    (if (>= (cadr pt) aaz)                                                        (setq gran (cadr pt) grand (car pt))                                                        (if (and (>= (cadr pt) aaz)(<= (cadr pt) peti))                                                            (setq gran (cadr pt) grand (car pt))                                    ))))))                                )                            )                            (if (eq resul nil)                                (if (and (/= nil peti) (/= nil gran))                                    (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est comprise entre " petit " et " grand " (" (rtos aaz 2 4) "xp)..."))                                    (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est trop petite pour être calculée (" (rtos aaz 2 4) "xp)."))                                )                                (princ (strcat "\nLa fenêtre sélectionnée est au " resul "ème."))                            )                            (if (setq quest2 (getreal "\n---->Nouvelle échelle de présentation (entrer le dénominateur, 1/) : "))                                (progn                                    (setq                                         newfr (strcat "1/" (rtos quest2 2 0))                                        newz (* divi (/ 1 quest2))                                        na45 (/ aa41 newz)                                    )                                    (princ (strcat "\nAncienne échelle : " (rtos (cdr (assoc 45 entaa))) " <-----> Nouvelle échelle : " (rtos na45)))                                    (entmod (subst (cons 45 na45) (assoc 45 entaa) entaa))                                    (entupd (cdr (assoc -1 entaa)))                                    (princ (strcat "\nLa fenêtre sélectionnée est maintenant au " newfr "ème (zoom " (rtos newz 2 4) "xp)."))                                    (redraw)                                )                                (princ "\nErreur lors de la saisie du dénominateur...")                            )                        )                        (princ (strcat "\nL'entité sélectionnée (" (cdr (assoc 0 (entget aa))) ") n'est pas de type 'VIEWPORT'... "))                    )                )            )        )        (princ "\nxxxxxxx---Passer en espace de présentation pour commencer le programme---xxxxxxx")    )    (princ));;Définition de la liste de toutes échelles, avec les unités MM, CM, et M.(defun listzoomxp ()    (setq listxp         (list             (cons "10/1" (list 10 100 10000))            (cons "5/1" (list 5 50 5000))            (cons "4/1" (list 4 40 4000))            (cons "3/1" (list 3 30 3000))            (cons "2/1" (list 2 20 2000))            (cons "1/1" (list 1 10 1000))            (cons "1/2" (list 0.5 5 500))            (cons "1/2" (list 0.5 5 500))            (cons "1/3" (list 0.3333 3.333 333.3))            (cons "1/4" (list 0.25 2.5 250))            (cons "1/5" (list 0.5 5 500))            (cons "1/5" (list 0.5 5 500))            (cons "1/10" (list 0.1 1 100))            (cons "1/20" (list 0.05 0.5 50))            (cons "1/25" (list 0.04 0.4 40))            (cons "1/30" (list 0.0333 0.3333 33.33))            (cons "1/50" (list 0.02 0.2 20))            (cons "1/100" (list 0.01 0.1 10))            (cons "1/200" (list 0.005 0.05 5))            (cons "1/250" (list 0.004 0.04 4))            (cons "1/500" (list 0.002 0.02 2))            (cons "1/1000" (list 0.001 0.01 1))            (cons "1/2000" (list 0.0005 0.005 0.5))            (cons "1/2500" (list 0.0004 0.004 0.4))            (cons "1/5000" (list 0.0002 0.002 0.2))            (cons "1/10000" (list 0.0001 0.001 0.1))        )    ))

Roy Klein Gebbinck · November 2008

Your code seems OK to me. The problem probably lies with BC8.As a workaround I have modified your code. It now deletes the old viewport and then creates a new one with the correct settings.

(defun C:vpscale (/ a refi aa quest divi resul peti gran)  (if (eq (getvar "tilemode") 0)      (progn          (if (getenv "echPresentation")              (setq l1 (getenv "echPresentation"))                (progn                  (setenv "echPresentation" "M")                  (setq l1 (getenv "echPresentation"))                )           )           (setq quest (strcase (getstring T (strcat "\nUnité du dessin [Mètre (m)/CentiMètres (cm)/MilliMètres (mm)] <" l1 "> : "))))         (if (eq quest "") (setq quest l1))          (setenv "echPresentation" quest)            (if (or (eq quest "M")(eq quest "CM")(eq quest "MM"))               (progn                  (if (eq quest "M")                      (setq divi 1000)                        (if (eq quest "CM")                         (setq divi 10)                          (if (eq quest "MM")                             (setq divi 1)                           )                       )                   )                   (listzoomxp)                    (while                      (or                         (not (setq aa (car (entsel "\nSélectionner la fenêtre d'impression : "))))                          (if (/= (cdr (assoc 0 (entget aa))) "VIEWPORT")                             (princ "\nL'objet sélectionné n'est de type VIEWPORT...")                           )                       )                   )                   (if aa                      (progn                          (setq                               entaa (entget aa)                               aa41 (cdr (assoc 41 entaa))                             aa45 (cdr (assoc 45 entaa))                             aaz (/ aa41 aa45)                               aazz (/ aaz divi)                           )                           (if (eq quest "M")                              (foreach pt listxp                                  (if (eq (cadddr pt) aaz)                                        (setq resul (car pt))                                       (if (and (<= (cadddr pt) aaz)(>= (cadddr pt) peti))                                         (setq peti (cadddr pt) petit (car pt))                                          (if (>= (cadddr pt) aaz)                                                (setq gran (cadddr pt) grand (car pt))                                              (if (and (>= (cadddr pt) aaz)(<= (cadddr pt) peti))                                                 (setq gran (cadddr pt) grand (car pt))                              )))))                               (if (eq quest "CM")                                 (foreach pt listxp                                      (if (eq (caddr pt) aaz)                                         (setq resul (car pt))                                           (if (and (<= (caddr pt) aaz)(>= (caddr pt) peti))                                               (setq peti (caddr pt) petit (car pt))                                               (if (>= (caddr pt) aaz)                                                 (setq gran (caddr pt) grand (car pt))                                                   (if (and (>= (caddr pt) aaz)(<= (caddr pt) peti))                                                       (setq gran (caddr pt) grand (car pt))                                   )))))                                   (if (eq quest "MM")                                     (foreach pt listxp                                          (if (eq (cadr pt) aaz)                                              (setq resul (car pt))                                               (if (and (<= (cadr pt) aaz)(>= (cadr pt) peti))                                                 (setq peti (cadr pt) petit (car pt))                                                    (if (>= (cadr pt) aaz)                                                      (setq gran (cadr pt) grand (car pt))                                                        (if (and (>= (cadr pt) aaz)(<= (cadr pt) peti))                                                         (setq gran (cadr pt) grand (car pt))                                    ))))))                              )                           )                           (if (eq resul nil)                              (if (and (/= nil peti) (/= nil gran))                                   (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est comprise entre " petit " et " grand " (" (rtos aaz 2 4) "xp)..."))                                 (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est trop petite pour être calculée (" (rtos aaz 2 4) "xp)."))                              )                               (princ (strcat "\nLa fenêtre sélectionnée est au " resul "ème."))                           )                           (if (setq quest2 (getreal "\n---->Nouvelle échelle de présentation (entrer le dénominateur, 1/) : "))                               (progn                                  (setq                                       newfr (strcat "1/" (rtos quest2 2 0))                                       newz (* divi (/ 1 quest2))                                      na45 (/ aa41 newz)                                  )                                   (princ (strcat "\nAncienne échelle : " (rtos (cdr (assoc 45 entaa))) " <-----> Nouvelle échelle : " (rtos na45)));;; *************************************************                                  (entdel (cdr (assoc -1 entaa)))     ; delete old viewport                                   (setq                                       entaa (STM-LIST-REMOVE-ITEMS entaa (assoc -1 entaa))                                        entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 5 entaa))                                     entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 68 entaa))                                        entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 69 entaa))                                        entaa (subst (cons 45 na45) (assoc 45 entaa) entaa)                                 )                                   (entmake entaa)                     ; create new viewport;;; *************************************************                                  (princ (strcat "\nLa fenêtre sélectionnée est maintenant au " newfr "ème (zoom " (rtos newz 2 4) "xp)."))                                   (redraw)                                )                               (princ "\nErreur lors de la saisie du dénominateur...")                         )                       )                       (princ (strcat "\nL'entité sélectionnée (" (cdr (assoc 0 (entget aa))) ") n'est pas de type 'VIEWPORT'... "))                   )               )           )       )       (princ "\nxxxxxxx---Passer en espace de présentation pour commencer le programme---xxxxxxx")    )   (princ));;Définition de la liste de toutes échelles, avec les unités MM, CM, et M.(defun listzoomxp ()  (setq listxp        (list           (cons "10/1" (list 10 100 10000))           (cons "5/1" (list 5 50 5000))           (cons "4/1" (list 4 40 4000))           (cons "3/1" (list 3 30 3000))           (cons "2/1" (list 2 20 2000))           (cons "1/1" (list 1 10 1000))           (cons "1/2" (list 0.5 5 500))           (cons "1/2" (list 0.5 5 500))           (cons "1/3" (list 0.3333 3.333 333.3))          (cons "1/4" (list 0.25 2.5 250))            (cons "1/5" (list 0.5 5 500))           (cons "1/5" (list 0.5 5 500))           (cons "1/10" (list 0.1 1 100))          (cons "1/20" (list 0.05 0.5 50))            (cons "1/25" (list 0.04 0.4 40))            (cons "1/30" (list 0.0333 0.3333 33.33))            (cons "1/50" (list 0.02 0.2 20))            (cons "1/100" (list 0.01 0.1 10))           (cons "1/200" (list 0.005 0.05 5))          (cons "1/250" (list 0.004 0.04 4))          (cons "1/500" (list 0.002 0.02 2))          (cons "1/1000" (list 0.001 0.01 1))         (cons "1/2000" (list 0.0005 0.005 0.5))         (cons "1/2500" (list 0.0004 0.004 0.4))         (cons "1/5000" (list 0.0002 0.002 0.2))         (cons "1/10000" (list 0.0001 0.001 0.1))        )   ))(defun STM-LIST-REMOVE-ITEMS (lst lstItem / a lstNew) (foreach a lst      (if (not (equal a lstItem))         (setq lstNew (append lstNew (list a)))      )   )   lstNew)

Antonio Ribeiro · November 2008

Hi Roy !Thank you for your solution !I seems to not work with polygonal viewports.. I will post a support request !Thank you again !

Roy Klein Gebbinck · November 2008

Matt you are right: the code in my previous post doesn't work on polygonal viewports.This workaround seems to do the trick:

(defun C:vpscale (/a refi aa quest divi resul peti granentName entLst entType tmpLst polyEntLstPart1 polyEntLstPart2 polyEntLstPart3reactorEntname reactorEntLst reactorEntType polyEntName polyEntLst newVportName newPolyEntLst)   (if (eq (getvar "tilemode") 0)      (progn          (if (getenv "echPresentation")              (setq l1 (getenv "echPresentation"))                (progn                  (setenv "echPresentation" "M")                  (setq l1 (getenv "echPresentation"))                )           )           (setq quest (strcase (getstring T (strcat "\nUnité du dessin [Mètre (m)/CentiMètres (cm)/MilliMètres (mm)] <" l1 "> : "))))         (if (eq quest "") (setq quest l1))          (setenv "echPresentation" quest)            (if (or (eq quest "M")(eq quest "CM")(eq quest "MM"))               (progn                  (if (eq quest "M")                      (setq divi 1000)                        (if (eq quest "CM")                         (setq divi 10)                          (if (eq quest "MM")                             (setq divi 1)                           )                       )                   )                   (listzoomxp);; *************************************************                    (while (= aa nil)                       (setq                           entName (car (entsel "\nSélectionner la fenêtre d'impression : "))                          entLst (entget entName)                         entType (strcase (cdr (assoc 0 entLst)))                        )                       (cond                           ((= entType "LWPOLYLINE")                               (if (setq tmpLst (STM-LIST-SPLIT-AT-FIRST-FOUND entLst (cons 102 "{ACAD_REACTORS") "before"))                                   (setq                                       polyEntLstPart1 (car tmpLst)                                        tmpLst (cadr tmpLst)                                        tmpLst (STM-LIST-SPLIT-AT-FIRST-FOUND tmpLst (cons 102 "}") "after")                                        polyEntLstPart2 (car tmpLst)                                        polyEntLstPart3 (cadr tmpLst)                                   )                               )                               (if (setq reactorEntname (cdr (assoc 330 polyEntLstPart2)))                                 (setq                                       reactorEntLst (entget reactorEntName)                                       reactorEntType (strcase (cdr (assoc 0 reactorEntLst)))                                  )                               )                               (if (= reactorEntType "VIEWPORT")                                   (setq                                       aa reactorEntname                                       polyEntName entName                                 )                               )                           )                           ((= entType "VIEWPORT")                             (setq aa entName)                               (if (setq polyEntName (cdr (assoc 340 entLst)))                                 (setq                                       polyEntLst (entget polyEntName)                                     tmpLst (STM-LIST-SPLIT-AT-FIRST-FOUND polyEntLst (cons 102 "{ACAD_REACTORS") "before")                                      polyEntLstPart1 (car tmpLst)                                        tmpLst (cadr tmpLst)                                        tmpLst (STM-LIST-SPLIT-AT-FIRST-FOUND tmpLst (cons 102 "}") "after")                                        polyEntLstPart3 (cadr tmpLst)                                   )                               )                           )                           ((= aa nil)                             (princ "\nL'objet sélectionné n'est de type VIEWPORT...")                           )                       )                   );; *************************************************                   (if aa                      (progn                          (setq                               entaa (entget aa)                               aa41 (cdr (assoc 41 entaa))                             aa45 (cdr (assoc 45 entaa))                             aaz (/ aa41 aa45)                               aazz (/ aaz divi)                           )                           (if (eq quest "M")                              (foreach pt listxp                                  (if (eq (cadddr pt) aaz)                                        (setq resul (car pt))                                       (if (and (<= (cadddr pt) aaz)(>= (cadddr pt) peti))                                         (setq peti (cadddr pt) petit (car pt))                                          (if (>= (cadddr pt) aaz)                                                (setq gran (cadddr pt) grand (car pt))                                              (if (and (>= (cadddr pt) aaz)(<= (cadddr pt) peti))                                                 (setq gran (cadddr pt) grand (car pt))                              )))))                               (if (eq quest "CM")                                 (foreach pt listxp                                      (if (eq (caddr pt) aaz)                                         (setq resul (car pt))                                           (if (and (<= (caddr pt) aaz)(>= (caddr pt) peti))                                               (setq peti (caddr pt) petit (car pt))                                               (if (>= (caddr pt) aaz)                                                 (setq gran (caddr pt) grand (car pt))                                                   (if (and (>= (caddr pt) aaz)(<= (caddr pt) peti))                                                       (setq gran (caddr pt) grand (car pt))                                   )))))                                   (if (eq quest "MM")                                     (foreach pt listxp                                          (if (eq (cadr pt) aaz)                                              (setq resul (car pt))                                               (if (and (<= (cadr pt) aaz)(>= (cadr pt) peti))                                                 (setq peti (cadr pt) petit (car pt))                                                    (if (>= (cadr pt) aaz)                                                      (setq gran (cadr pt) grand (car pt))                                                        (if (and (>= (cadr pt) aaz)(<= (cadr pt) peti))                                                         (setq gran (cadr pt) grand (car pt))                                    ))))))                              )                           )                           (if (eq resul nil)                              (if (and (/= nil peti) (/= nil gran))                                   (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est comprise entre " petit " et " grand " (" (rtos aaz 2 4) "xp)..."))                                 (princ (strcat "\nL'échelle de présentation n'est pas fixe. Elle est trop petite pour être calculée (" (rtos aaz 2 4) "xp)."))                              )                               (princ (strcat "\nLa fenêtre sélectionnée est au " resul "ème."))                           )                           (if (setq quest2 (getreal "\n---->Nouvelle échelle de présentation (entrer le dénominateur, 1/) : "))                               (progn                                  (setq                                       newfr (strcat "1/" (rtos quest2 2 0))                                       newz (* divi (/ 1 quest2))                                      na45 (/ aa41 newz)                                  )                                   (princ (strcat "\nAncienne échelle : " (rtos (cdr (assoc 45 entaa))) " <-----> Nouvelle échelle : " (rtos na45)));; *************************************************                                   (entdel (cdr (assoc -1 entaa))) ; delete old viewport                                   (setq                                       entaa (STM-LIST-REMOVE-ITEMS entaa (assoc -1 entaa))                                        entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 5 entaa))                                     entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 68 entaa))                                        entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 69 entaa))                                        entaa (STM-LIST-REMOVE-ITEMS entaa (assoc 340 entaa))                                       entaa (subst (cons 45 na45) (assoc 45 entaa) entaa)                                 )                                   (entmake entaa) ; create new viewport                                   (if polyEntName                                     (progn;                                         (entdel polyEntName)    ; this has strange results so don't uncomment this line!                                            (setq                                               newVportName (entlast)                                              newPolyEntLst (append polyEntLstPart1 polyEntLstPart3)                                              newPolyEntLst (STM-LIST-REMOVE-ITEMS newPolyEntLst (assoc -1 newPolyEntLst))                                                newPolyEntLst (STM-LIST-REMOVE-ITEMS newPolyEntLst (assoc 5 newPolyEntLst))                                         )                                           (entmake newPolyEntLst) ; create new polyline                                           (setq newPolyName (entlast))                                            (setvar "CMDECHO" 0)                                            (command "_vpclip" newVportName newPolyName)                                            (setvar "CMDECHO" 1)                                        )                                   );;; *************************************************                                  (princ (strcat "\nLa fenêtre sélectionnée est maintenant au " newfr "ème (zoom " (rtos newz 2 4) "xp)."))                                   (redraw)                                )                               (princ "\nErreur lors de la saisie du dénominateur...")                         )                       )                       (princ (strcat "\nL'entité sélectionnée (" (cdr (assoc 0 (entget aa))) ") n'est pas de type 'VIEWPORT'... "))                   )               )           )       )       (princ "\nxxxxxxx---Passer en espace de présentation pour commencer le programme---xxxxxxx")    )   (princ));;Définition de la liste de toutes échelles, avec les unités MM, CM, et M.(defun listzoomxp ()  (setq listxp        (list           (cons "10/1" (list 10 100 10000))           (cons "5/1" (list 5 50 5000))           (cons "4/1" (list 4 40 4000))           (cons "3/1" (list 3 30 3000))           (cons "2/1" (list 2 20 2000))           (cons "1/1" (list 1 10 1000))           (cons "1/2" (list 0.5 5 500))           (cons "1/2" (list 0.5 5 500))           (cons "1/3" (list 0.3333 3.333 333.3))          (cons "1/4" (list 0.25 2.5 250))            (cons "1/5" (list 0.5 5 500))           (cons "1/5" (list 0.5 5 500))           (cons "1/10" (list 0.1 1 100))          (cons "1/20" (list 0.05 0.5 50))            (cons "1/25" (list 0.04 0.4 40))            (cons "1/30" (list 0.0333 0.3333 33.33))            (cons "1/50" (list 0.02 0.2 20))            (cons "1/100" (list 0.01 0.1 10))           (cons "1/200" (list 0.005 0.05 5))          (cons "1/250" (list 0.004 0.04 4))          (cons "1/500" (list 0.002 0.02 2))          (cons "1/1000" (list 0.001 0.01 1))         (cons "1/2000" (list 0.0005 0.005 0.5))         (cons "1/2500" (list 0.0004 0.004 0.4))         (cons "1/5000" (list 0.0002 0.002 0.2))         (cons "1/10000" (list 0.0001 0.001 0.1))        )   ));;; *************************************************(defun STM-LIST-REMOVE-ITEMS (lst lstItem / a lstNew)    (foreach a lst      (if (not (equal a lstItem))         (setq lstNew (append lstNew (list a)))      )   )   lstNew)(defun STM-LIST-SPLIT-AT-FIRST-FOUND (lst lstItem option / lstEnd lstItemIndex i lstBegin)   (setq option (strcase option))  (if (= option "AFTER") (setq option "A"))   (if (= option "BEFORE") (setq option "B"))  (if (= option "REMOVE") (setq option "R"))  (if (setq lstEnd (member lstItem lst))      (progn          (if (or (= option "A") (= option "R"))              (setq lstEnd (cdr lstEnd))          )           (setq lstItemIndex (- (length lst) (length lstEnd)))            (if (= option "R")              (setq lstItemIndex (- lstItemIndex 1))          )           (setq i 0)          (while (< i lstItemIndex)               (setq lstBegin (append lstBegin (list (nth i lst))))                (setq i (+ i 1))            )           (list lstBegin lstEnd)  ; If lstItem is in lst then a list containing two lists: lstBegin and lstEnd, is returned.      )       nil                         ; Else nil is returned. ))(princ "\nUtiliser \"vpscale\". ")(princ);;; *************************************************

IMPORTANT:DO NOT USE UNDO AFTER USING THIS LISP!

Viewport+Entmod !

Comments