FastFiber

OPGELOST - Zoom Width / Zoom Height

Gestart door gery, wo 04 01 2017, 17:27:34

Vorige topic - Volgende topic

gery

Ik ben op zoek naar 2 AutoLISP routines:
1. Zoom Width: om verticaal lange tekeningen uit te zoomen op de maximale tekeningbreedte, dus als ik ingezoomd ben op een bepaald punt dient de tekening uitgezoomd te worden tot de maximale tekeningbreedte maar met de originele vertikale positie.
2. Zoom Height: om horizontaal lange tekeningen uit te zoomen op de maximale tekeninghoogte, dus als ik ingezoomd ben op een bepaald punt dient de tekening uitgezoomd te worden tot de maximale tekeninghoogte maar met de originele horizontale positie.

Hopelijk is mijn vraag een beetje duidelijk.

Heeft iemand zulke routines of kan iemand me op weg zetten aub?

Ik gebruik AutoCAD 2012.
AutoCAD 2020 - Windows 10

roy_043

Probeer c:ZoomMinExt:
(defun c:ZoomMinExt ( / box cad cen doc vec)
  (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
  (vla-endundomark doc) ; End open undo group.
  (vla-startundomark doc)
  (vla-regen doc acactiveviewport) ; Required.
  (setq box ; In DCS.
    (KGA_Geom_PointListBoundingbox
      (mapcar
        '(lambda (pt) (trans pt 0 2))
        (KGA_Geom_BoundingboxAllPoints (list (getvar 'extmin) (getvar 'extmax)))
      )
    )
  )
  (setq vec (apply 'mapcar (cons '- (reverse box))))
  (setq cen (trans (getvar 'viewctr) 1 2))
  (if (> (car vec) (cadr vec))
    (vla-zoomcenter ; Landscape.
      cad
      (vlax-3d-point (trans (list (car cen) (/ (+ (cadar box) (cadadr box)) 2.0) 0.0) 2 0))
      (* 1.05 (cadr vec))
    )
    (vla-zoomcenter ; Portrait.
      cad
      (vlax-3d-point (trans (list (/ (+ (caar box) (caadr box)) 2.0) (cadr cen) 0.0) 2 0))
      (* 1.05 (car vec) (apply '/ (reverse (getvar 'screensize))))
    )
  )
  (vla-endundomark doc)
  (princ)
)

; The first point of the box must have the lowest x, y and z-coordinates.
; If both points are 3D the order of the points in the output is:
; ((FBL) (FBR) (FTL) (FTR) (CBL) (CBR) (CTL) (CTR)). Where F=floor and C=ceiling.
; Else the output is: ((BL) (BR) (TL) (TR)).
; (KGA_Geom_BoundingboxAllPoints '((1 2 3) (4 5 6))) => ((1 2 3) (4 2 3) (1 5 3) (4 5 3) (1 2 6) (4 2 6) (1 5 6) (4 5 6))
; (KGA_Geom_BoundingboxAllPoints '((1 2 3) (4 5))) => ((1 2) (4 2) (1 5) (4 5))
; (KGA_Geom_BoundingboxAllPoints '((1 2) (4 5 6))) => ((1 2) (4 2) (1 5) (4 5))
(defun KGA_Geom_BoundingboxAllPoints (box)
  (apply
    'append
    (apply
      'append
      (mapcar
        '(lambda (lstZ)
          (mapcar
            '(lambda (y)
              (mapcar
                '(lambda (x)
                  (vl-list* x y lstZ)
                )
                (mapcar 'car box)
              )
            )
            (mapcar 'cadr box)
          )
        )
        (if (and (cddar box) (cddadr box)) ; Check for both z-coordinates.
          (mapcar 'cddr box)
          '(nil)
        )
      )
    )
  )
)

; See: http://www.theswamp.org/index.php?topic=35254.0
; (KGA_Geom_PointListBoundingbox '((-2.0 0.0 4.0) (0.0 2.0) (3.0 0.0) (0 -3.0 7.5))) => ((-2.0 -3.0) (3.0 2.0))
(defun KGA_Geom_PointListBoundingbox (ptLst)
  (list
    (apply 'mapcar (cons 'min ptLst))
    (apply 'mapcar (cons 'max ptLst))
  )
)

gery

Bedankt Roy, deze routine doet wat ik wil, met zelfs automatische selectie van "width" of "height".
AutoCAD 2020 - Windows 10

roy_043

#3
N.a.v. Gery's verzoek (zie hier) een nieuwe versie die rekening houdt met gelockte viewports:
; 20170410B: Omschakeling MS-PS werkte niet in AutoCAD.
; 20170410 : Functie houdt nu rekening met gelockte viewport.
; 20170105
(defun c:ZoomMinExt ( / box cad cen doc vec vp vpId vpLockedP)
  (setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
  (vla-endundomark doc) ; End open undo group.
  (vla-startundomark doc)
  (vla-regen doc acactiveviewport) ; Required.
  (setq vpLockedP
    (and
      (zerop (getvar 'tilemode))
      (/= 1 (getvar 'cvport))
      (setq vp
        (vlax-ename->vla-object
          (ssname
            (ssget "_X" (list (cons 410 (getvar 'ctab)) (cons 69 (setq vpId (getvar 'cvport)))))
            0
          )
        )
      )
      (= :vlax-true (vla-get-displaylocked vp))
    )
  )
  (if vpLockedP
    (progn
      (princ "\nViewport is view-locked. Switching to Paper space. ")
      ; (setvar 'cvport 1) ; Works in BC not in AC.
      (vla-put-mspace doc :vlax-false)
    )
  )
  (setq box ; In DCS.
    (KGA_Geom_PointListBoundingbox
      (mapcar
        '(lambda (pt) (trans pt 0 2))
        (KGA_Geom_BoundingboxAllPoints (list (getvar 'extmin) (getvar 'extmax)))
      )
    )
  )
  (setq vec (apply 'mapcar (cons '- (reverse box))))
  (setq cen (trans (getvar 'viewctr) 1 2))
  (if (> (car vec) (cadr vec))
    (vla-zoomcenter ; Landscape.
      cad
      (vlax-3d-point (trans (list (car cen) (/ (+ (cadar box) (cadadr box)) 2.0) 0.0) 2 0))
      (* 1.05 (cadr vec))
    )
    (vla-zoomcenter ; Portrait.
      cad
      (vlax-3d-point (trans (list (/ (+ (caar box) (caadr box)) 2.0) (cadr cen) 0.0) 2 0))
      (* 1.05 (car vec) (apply '/ (reverse (getvar 'screensize))))
    )
  )
  (if vpLockedP
    (progn
      (princ "\nSwitching back to Model space. ")
      ; (setvar 'cvport vpId) ; Works in BC not in AC.
      (vla-put-mspace doc :vlax-true)
    )
  )
  (vla-endundomark doc)
  (princ)
)

; The first point of the box must have the lowest x, y and z-coordinates.
; If both points are 3D the order of the points in the output is:
; ((FBL) (FBR) (FTL) (FTR) (CBL) (CBR) (CTL) (CTR)). Where F=floor and C=ceiling.
; Else the output is: ((BL) (BR) (TL) (TR)).
; (KGA_Geom_BoundingboxAllPoints '((1 2 3) (4 5 6))) => ((1 2 3) (4 2 3) (1 5 3) (4 5 3) (1 2 6) (4 2 6) (1 5 6) (4 5 6))
; (KGA_Geom_BoundingboxAllPoints '((1 2 3) (4 5))) => ((1 2) (4 2) (1 5) (4 5))
; (KGA_Geom_BoundingboxAllPoints '((1 2) (4 5 6))) => ((1 2) (4 2) (1 5) (4 5))
(defun KGA_Geom_BoundingboxAllPoints (box)
  (apply
    'append
    (apply
      'append
      (mapcar
        '(lambda (lstZ)
          (mapcar
            '(lambda (y)
              (mapcar
                '(lambda (x)
                  (vl-list* x y lstZ)
                )
                (mapcar 'car box)
              )
            )
            (mapcar 'cadr box)
          )
        )
        (if (and (cddar box) (cddadr box)) ; Check for both z-coordinates.
          (mapcar 'cddr box)
          '(nil)
        )
      )
    )
  )
)

; See: http://www.theswamp.org/index.php?topic=35254.0
; (KGA_Geom_PointListBoundingbox '((-2.0 0.0 4.0) (0.0 2.0) (3.0 0.0) (0 -3.0 7.5))) => ((-2.0 -3.0) (3.0 2.0))
(defun KGA_Geom_PointListBoundingbox (ptLst)
  (list
    (apply 'mapcar (cons 'min ptLst))
    (apply 'mapcar (cons 'max ptLst))
  )
)

gery

Merci voor de code Roy.
Ik krijg echter volgende melding in het tekstscherm:
Viewport is view-locked. Switching to Paper space. ; error: AutoCAD variable setting rejected: CVPORT 1
AutoCAD 2020 - Windows 10

roy_043

Ik heb de code in mijn vorige bericht aangepast.

gery

Nu werkt het perfect. Super! Bedankt Roy.
AutoCAD 2020 - Windows 10

FastFiber