_

Eksport obrysu rzutni z arkuszy

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Eksport obrysu rzutni z arkuszy

Postprzez 88marcin » lut 03, 2018 16:17

Witam,
nie wiem jak to opisać, ale chodzi mi o to, że mam rysunek (mapa), dla którego porobiłem 1 rzutnię prostokątna w 1 arkuszu. Arkuszy jest kilkanaście/kilkadziesiąt.

Chce uzyskać taki efekt żeby mi "wyeksportowało " zakresy (prostokątne obrysy) zgodnie z ich rzeczywistym umiejscowieniem i skalą do modelu, tak żebym widział pokrycie mapy tymi rzutniami. Wtedy mi wyjdzie tak jakby mapa orientacji w terenie z pokryciem arkuszami.

Mam nadzieje że zrozumiale wyjaśniłem.

Czy jest takie narzędzie/sposób (lisp) żeby to zrobić?
88marcin
 
Posty: 78
Dołączył(a): mar 22, 2016 12:08

Re: Eksport obrysu rzutni z arkuszy

Postprzez Jerry » lut 03, 2018 18:04

Narysuj sobie w arkuszu prostokąt wielkości jakiej potrzebujesz.
Następnie skorzystaj z polecenie _CHSPACE i postępuj jak ci program podpowiada.
Jerry
Jerry
 
Posty: 208
Dołączył(a): paź 02, 2005 18:35
Lokalizacja: Gdańsk

Re: Eksport obrysu rzutni z arkuszy

Postprzez 88marcin » lut 03, 2018 18:21

Super.

O to chodziło. Dzięki.

Ciekawe czy dało by się to lispem zrobić odn. wszystkich arkuszy w rysunku...
88marcin
 
Posty: 78
Dołączył(a): mar 22, 2016 12:08

Re: Eksport obrysu rzutni z arkuszy

Postprzez wilda » lut 03, 2018 22:55

wilda
 
Posty: 217
Dołączył(a): gru 18, 2007 21:41

Re: Eksport obrysu rzutni z arkuszy

Postprzez ziele_o2k » lut 03, 2018 23:47

88marcin napisał(a):Ciekawe czy dało by się to lispem zrobić odn. wszystkich arkuszy w rysunku...

Bardzo delikatnie sugerujesz, że może by ktoś wrzucił takiego lispa :)
Akurat się tak fajnie składa, że w tygodniu potrzebowałem taki program :)
Kod: Zaznacz cały
;;-----------------------=={ Viewport Outline }==-----------------------;;
;;                                                                      ;;
;;  This program allows the user to automatically generate a polyline   ;;
;;  in modelspace representing the outline of a selected paperspace     ;;
;;  viewport.                                                           ;;
;;                                                                      ;;
;;  The command is only available in paperspace (that is, when a        ;;
;;  layout tab other than the Model tab is the current layout, and no   ;;
;;  viewports are active).                                              ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'VPO' at the AutoCAD command-line,  ;;
;;  the user is prompted to select a viewport for which to construct    ;;
;;  the viewport outline in modelspace.                                 ;;
;;                                                                      ;;
;;  Following a valid selection, the boundary of the selected viewport  ;;
;;  is transformed appropriately to account for the position, scale,    ;;
;;  rotation, & orientation of the modelspace view displayed through    ;;
;;  the selected viewport, and a 2D polyline (LWPolyline) representing  ;;
;;  this transformed boundary is constructed in modelspace.             ;;
;;                                                                      ;;
;;  The program is compatible for use with all Rectangular, Polygonal & ;;
;;  Clipped Viewports (including those with Arc segments), and with all ;;
;;  views & construction planes.                                        ;;
;;                                                                      ;;
;;  The program also offers the ability to optionally offset the        ;;
;;  polyline outline to the interior of the viewport boundary by a      ;;
;;  predetermined number of paperspace units specified in the           ;;
;;  'Program Parameters' section of the program source code.            ;;
;;                                                                      ;;
;;  The program may also be configured to automatically apply a         ;;
;;  predefined set of properties (e.g. layer, colour, linetype, etc.)   ;;
;;  to the resulting polyline outline - these properties are also       ;;
;;  listed within the 'Program Parameters' section of the source code.  ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2015  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2015-01-02                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-08-11                                      ;;
;;                                                                      ;;
;;  - Program modified to account for polygonal viewports represented   ;;
;;    by 2D (Heavy) Polylines.                                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2017-09-03                                      ;;
;;                                                                      ;;
;;  - Added the ability to specify an optional interior offset          ;;
;;    (relative to Paperspace Viewport dimensions).                     ;;
;;  - Added default polyline properties.                                ;;
;;----------------------------------------------------------------------;;

;;----------------------------------------------------------------------;;
;;  Modifications:  ziele_o2k                                           ;;
;;----------------------------------------------------------------------;;
;;  Added 2 commands                                                    ;;
;;  - vpoc - outline all viewports in current layout                    ;;
;;  - vpoa - outline all viewports in all layouts                       ;;                                                                    ;;
;;----------------------------------------------------------------------;;

(defun c:vpo  nil (pz:vpo 1) (princ))
(defun c:vpoc nil (pz:vpo 2) (princ))
(defun c:vpoa nil (pz:vpo 3) (princ))

(defun pz:vpo ( @mode / *error* cen dpr ent lst ocs ofe off tmp vpe vpt )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq

;;----------------------------------------------------------------------;;
;;                          Program Parameters                          ;;
;;----------------------------------------------------------------------;;

        ;; Optional Interior Offset
        ;; Set this parameter to nil or 0.0 for no offset
        off 0.0

        ;; Default Polyline Properties
        ;; Omitted properties will use current settings when the program is run
        dpr
       '(
            (006 . "BYLAYER")   ;; Linetype (must be loaded)
            (008 . "VPOutline") ;; Layer (automatically created if not present in drawing)
            (039 . 0.0)         ;; Thickness
            (048 . 1.0)         ;; Linetype Scale
            (062 . 256)         ;; Colour (0 = ByBlock, 256 = ByLayer)
            (370 . -1)          ;; Lineweight (-1 = ByLayer, -2 = ByBlock, -3 = Default, 0.3 = 30 etc.)
        )
       
;;----------------------------------------------------------------------;;

    )
   
    (LM:startundo (LM:acdoc))
    (cond
        (   (and (/= 1 (getvar 'cvport)) (or (= @mode 1) (= @mode 2)))
            (princ "\nCommand not available in Modelspace.")
        )
        (   (cond
              ( (and
                  (= @mode 1)
                  (setq vpt (LM:ssget "\nSelect viewport: " '("_+.:E:S" ((0 . "VIEWPORT")))))
                )
                t
              )
              ( (and
                  (= @mode 2) (not (= (getvar 'ctab) "Model"))
                  (setq vpt (ssget "_X" (list '(0 . "VIEWPORT" ) (cons 410 (getvar 'ctab)) '(-4 . ">") '(69 . 1))))
                )
                t
              )
              ( (and 
                  (= @mode 3)
                  (setq vpt (ssget "_X" '((0 . "VIEWPORT") (-4 . "<NOT") (410 . "Model") (-4 . "NOT>") (-4 . ">") (69 . 1))))
                )
                t
              )
              ( t nil )
            )
            (foreach % (cd:SSX_Convert vpt 0)
              (setq vpt (entget %))
                (if (setq ent (cdr (assoc 340 vpt)))
                    (setq lst (vpo:polyvertices ent))
                    (setq cen (mapcar 'list (cdr (assoc 10 vpt))
                                  (list
                                      (/ (cdr (assoc 40 vpt)) 2.0)
                                      (/ (cdr (assoc 41 vpt)) 2.0)
                                  )
                              )
                          lst (mapcar
                                 '(lambda ( a ) (cons (mapcar 'apply a cen) '(42 . 0.0)))
                                 '((- -) (+ -) (+ +) (- +))
                              )
                    )
                )
                (if (not (LM:listclockwise-p (mapcar 'car lst)))
                    (setq lst (reverse (mapcar '(lambda ( a b ) (cons (car a) (cons 42 (- (cddr b))))) lst (cons (last lst) lst))))
                )
                (if (and (numberp off) (not (equal 0.0 off 1e-8)))
                    (cond
                        (   (null
                                (setq tmp
                                    (entmakex
                                        (append
                                            (list
                                               '(000 . "LWPOLYLINE")
                                               '(100 . "AcDbEntity")
                                               '(100 . "AcDbPolyline")
                                                (cons 90 (length lst))
                                               '(070 . 1)
                                            )
                                            (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (car x)) (cdr x))) lst))
                                        )
                                    )
                                )
                            )
                            (princ "\nUnable to generate Paperspace outline for offset.")
                        )
                        (   (vl-catch-all-error-p (setq ofe (vl-catch-all-apply 'vlax-invoke (list (vlax-ename->vla-object tmp) 'offset off))))
                            (princ (strcat "\nViewport dimensions too small to offset outline by " (rtos off) " units."))
                            (entdel tmp)
                        )
                        (   (setq ofe (vlax-vla-object->ename (car ofe))
                                  lst (vpo:polyvertices ofe)
                            )
                            (entdel ofe)
                            (entdel tmp)
                        )
                  )
                )
                (setq vpe (cdr (assoc -1 vpt))
                      ocs (cdr (assoc 16 vpt))
                )
                (entmakex
                    (append
                        (list
                           '(000 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(100 . "AcDbPolyline")
                            (cons 90 (length lst))
                           '(070 . 1)
                           '(410 . "Model")
                        )
                        (if (and (setq ltp (assoc 6 dpr)) (not (tblsearch "ltype" (cdr ltp))))
                            (progn
                                (princ  (strcat "\n\"" (cdr ltp) "\" linetype not loaded - linetype set to \"ByLayer\"."))
                                (subst '(6 . "BYLAYER") ltp dpr)
                            )
                            dpr
                        )
                        (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst))
                        (list (cons 210 ocs))
                    )
                )
            )
        )
    )
    (LM:endundo (LM:acdoc))
    (princ)
)

(defun vpo:polyvertices ( ent )
    (apply '(lambda ( foo bar ) (foo bar))
        (if (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
            (list
                (lambda ( enx )
                    (if (setq enx (member (assoc 10 enx) enx))
                        (cons (cons  (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (cdr enx)))
                    )
                )
                (entget ent)
            )
            (list
                (lambda ( ent / enx )
                    (if (= "VERTEX" (cdr (assoc 0 (setq enx (entget ent)))))
                        (cons (cons (cdr (assoc 10 enx)) (assoc 42 enx)) (foo (entnext ent)))
                    )
               )
                (entnext ent)
            )
        )
    )
)

;; List Clockwise-p  -  Lee Mac
;; Returns T if the point list is clockwise oriented

(defun LM:listclockwise-p ( lst )
    (minusp
        (apply '+
            (mapcar
                (function
                    (lambda ( a b )
                        (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                    )
                )
                lst (cons (last lst) lst)
            )
        )
    )
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

;; PCS2WCS (gile)
;; Translates a PCS point to WCS based on the supplied Viewport
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;; pnt : PCS point
;; ent : Viewport ename

(defun PCS2WCS ( pnt ent / ang enx mat nor scl )
    (setq pnt (trans pnt 0 0)
          enx (entget ent)
          ang (- (cdr (assoc 51 enx)))
          nor (cdr (assoc 16 enx))
          scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))
          mat (mxm
                  (mapcar (function (lambda ( v ) (trans v 0 nor t)))
                     '(   (1.0 0.0 0.0)
                          (0.0 1.0 0.0)
                          (0.0 0.0 1.0)
                      )
                  )
                  (list
                      (list (cos ang) (- (sin ang)) 0.0)
                      (list (sin ang)    (cos ang)  0.0)
                     '(0.0 0.0 1.0)
                  )
              )
    )
    (mapcar '+
        (mxv mat
            (mapcar '+
                (vxs pnt scl)
                (vxs (cdr (assoc 10 enx)) (- scl))
                (cdr (assoc 12 enx))
            )
        )
        (cdr (assoc 17 enx))
    )
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
    (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
    (mapcar '(lambda ( n ) (* n s)) v)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

;;----------------------------------------------------------------------;;

;(princ
;    (strcat
;        "\n:: VPOutline.lsp | Version 1.2 | \\U+00A9 Lee Mac "
;        (menucmd "m=$(edtime,0,yyyy)")
;        " www.lee-mac.com ::"
;        "\n:: Type \"vpo\" to Invoke ::"
;    )
;)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;


edit:
vpo - wybrana rzutnia
vpoc - wszystkie rzutnie w aktualnym layoucie
vpoa - wszystkie rzutnie we wszystkich layoutach
Ostatnio edytowany przez ziele_o2k, lut 03, 2018 23:50, edytowano w sumie 1 raz
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Eksport obrysu rzutni z arkuszy

Postprzez ziele_o2k » lut 03, 2018 23:49

wilda napisał(a):chwila i masz odpowiedź!!!
http://lmgtfy.com/?q=autocad+lisp+viewport+outline

Wszystko fajnie, ale takiego lispa co by robił wszystkie viewporty za jednym kliknięciem to nie znalazłem
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Eksport obrysu rzutni z arkuszy

Postprzez wilda » lut 04, 2018 16:35

A to słabo szukałeś :D
Drugi znaleziony temat w wynikach wyszukiwania.
wilda
 
Posty: 217
Dołączył(a): gru 18, 2007 21:41

Re: Eksport obrysu rzutni z arkuszy

Postprzez ziele_o2k » lut 04, 2018 17:27

wilda napisał(a):A to słabo szukałeś :D
Drugi znaleziony temat w wynikach wyszukiwania.

wrzuć linka, zobaczę sobie z ciekawości (jak wiadomo google u każdego może dać różne wyniki)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 682
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań



Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników