CADsite forum

AutoCAD => Autolisp => Topic gestart door: gery op wo 04 01 2017, 17:27:34

Titel: OPGELOST - Zoom Width / Zoom Height
Bericht door: gery op wo 04 01 2017, 17:27:34
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.
Titel: Re: Zoom Width / Zoom Height
Bericht door: roy_043 op do 05 01 2017, 00:02:41
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))
  )
)
Titel: Re: Zoom Width / Zoom Height
Bericht door: gery op do 05 01 2017, 09:40:09
Bedankt Roy, deze routine doet wat ik wil, met zelfs automatische selectie van "width" of "height".
Titel: Re: Zoom Width / Zoom Height (OPGELOST)
Bericht door: roy_043 op ma 10 04 2017, 15:53:34
N.a.v. Gery's verzoek (zie hier (http://www.cadsite.be/smf/index.php?topic=6593.0)) 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))
  )
)
Titel: Re: Zoom Width / Zoom Height (OPGELOST)
Bericht door: gery op ma 10 04 2017, 21:39:28
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
Titel: Re: Zoom Width / Zoom Height (OPGELOST)
Bericht door: roy_043 op ma 10 04 2017, 22:52:41
Ik heb de code in mijn vorige bericht aangepast.
Titel: Re: Zoom Width / Zoom Height (OPGELOST)
Bericht door: gery op ma 10 04 2017, 23:26:47
Nu werkt het perfect. Super! Bedankt Roy.