Viewport na modelu

[Noodles]

Cześć,

Przesiadłem się ostatnio na GstarCAD'a a jak wiadomo przy takowej zmianie lubią wysypać się różne krzaczki, oto i jeden:

Posiadam lisp do pokazywania linii viewportów z layoutów na modelu (możliwość zaznaczenia kilku viewportów/każdy layout posiada inne kolory). W autocadzie działał bez zarzutów, natomiast w gstarcad'zie  mogę zaznaczyć viewporty, tworzy odpowiednią warstwę, ale niczego nie pokazuje na modelu. Czy istnieje jakaś możliwość, abym uruchomił to pod Gstarem?

  Pokaż ukrytą zawartość

(defun c:bvp (/ *error* ss p1 p2 id ent vpID clay)
  (defun *error* (errmsg)
    (while (> (getvar "CMDACTIVE") 0) (princ "\n***") (command))
    (setvar "EXPERT" 0)
    (setvar "CECOLOR" "BYLAYER")
    (if clay (setvar "CLAYER" clay))
    (princ "\n** ERROR **\n")
    (princ errmsg)(terpri)
    (command "_.undo" "_end")
    (princ)
  )
  (setvar "CMDECHO" 0)
  (setvar "EXPERT" 1)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "CVPORT") 1)
        (progn
          (command "._pspace")
          (princ "Switching to Paper space.")
        )
      )
      (if (or (setq ss (ssget "_I" '((0 . "VIEWPORT")))) (setq ss (ssget '((0 . "VIEWPORT")))))
        (progn
          (setq id -1)
          (command "_.undo" "_begin")
          (setq clay (getvar "CLAYER"))
          (makelay "vp-outline" 5 "Continuous")
          (command "._-layer" "_Plot" "_No" "vp-outline" "_Set" "vp-outline" "")
          (command "._vplayer" "_Vpvisdflt" "vp-outline" "_Frozen" "")
          (command "._vplayer" "_Freeze" "vp-outline" "_All" "")
          (repeat (sslength ss)
            (setq ent (ssname ss (setq id (1+ id))))
            (setq vpID (dxf 69 (entget ent)))
            (if (> vpID 1)
              (progn
                (setvar "CECOLOR" (rtos (dxf (dxf 410 (entget ent)) (layoutorderlist)) 2 0))
                (vpo ent)
                (if (not (tblsearch "APPID" "VPO"))
                  (regapp "VPO")
                )
                (entmod (append (entget (entlast)) (list (list -3 (list "VPO" (cons 1000 (dxf 410 (entget ent))))))))
              )
            )
          )
          (setvar "CECOLOR" "BYLAYER")
          (setvar "CLAYER" clay)
          (command "_.undo" "_end")
        )
        (command "_.graphscr")
      )
    )
    (progn
      (princ "\n** Command not allowed in Model Tab **")
      (command "_.graphscr")
    )
  )
  (setvar "EXPERT" 0)
  (princ)
)
 

 

[kruszynski]

Trudno powiedzieć co może być przyczyną problemu. Załączony fragment jest częścią większej całości - korzysta z funkcji które nie są funkcjami z obszaru AutoLISP czy VisualLISP.

[Noodles]

Załączam całość

 

  Pokaż ukrytą zawartość

(defun dictobjname (ename symbol) (cdr (assoc -1 (dictsearch ename symbol))))

(defun dxf (dxf ename) (cdr (assoc dxf ename)))

(defun layoutorderlist (/ tblrewind dictename ent layoutname layoutorder layoutorderlist)
  (setq tblrewind 1)
  (setq dictename (dictobjname (namedobjdict) "ACAD_LAYOUT"))
  (while (setq ent (member '(100 . "AcDbLayout") (dictnext dictename tblrewind)))
    (setq tblrewind nil)
    (setq layoutname (dxf 1 ent)) ;Layout name
    (setq layoutorder (dxf 71 ent)) ;Tab order
    (setq layoutorderlist (append layoutorderlist (list (cons layoutname layoutorder))))
  )
  (setq layoutorderlist (vl-sort layoutorderlist '(lambda (x y) (< (cdr x) (cdr y)))))
)

(defun c:mvp (/ *error* ss p1 p2 id ent vpID vpStatus vpLock vpOn vpNotActive vpCB)
  (defun *error* (errmsg)
    (while (> (getvar "CMDACTIVE") 0) (princ "\n***") (command))
    (setvar "EXPERT" 0)
    (princ "\n** ERROR **\n")
    (princ errmsg)(terpri)
    (command "_.undo" "_end")
    (princ)
  )
  (setvar "CMDECHO" 0)
  (setvar "EXPERT" 1)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "CVPORT") 1)
        (progn
          (command "._pspace")
          (princ "Switching to Paper space.")
        )
      )
      (if (or (setq ss (ssget "_I" '((0 . "VIEWPORT")))) (setq ss (ssget '((0 . "VIEWPORT")))))
        (progn
          (setq p1 (getpoint "\nSpecify base point:"))
          (setq p2 (getpoint p1 "\nSpecify second point:"))
          (setq id -1)
          (command "_.undo" "_begin")
          (command "._mspace")
          (repeat (sslength ss)
            (setq ent (ssname ss (setq id (1+ id))))
            (setq vpID (dxf 69 (entget ent)))
            (setq vpStatus (dxf 90 (entget ent)))
            (setq vpLock (= (logand vpStatus 16384) 16384))
            (setq vpOn (dxf 68 (entget ent)))
            (if (eq vpOn -1)
              (command "_.mview" "_ON" ent "") ;Viewport was not active!
            )
            (if (eq vpOn 0)
              (progn
                ;(princ "\nViewport was off!")
                (command "_.mview" "_ON" ent "")
              )
            )
            (if vpLock
              (progn
                ;(princ "\nViewport was locked!")
                (command "_.mview" "_l" "_off" ent "")
              )
            )
            (if (setq vpNotActive (eq (dxf 68 (entget ent)) -1)) ;Viewport is still not active!
              (progn
                ;(princ "\nViewport was still not active, so was zoomed to it!")
                (command "_.pspace")
                (if (setq vpCB (dxf 340 (entget ent)))
                  (command "_.zoom" "_O" vpCB "")
                  (command "_.zoom" "_O" ent "")
                )
                (command "_.mview" "_ON" ent "")
                (command "._mspace")
              )
            )
            (setvar "CVPORT" vpID)
            (command "_.-pan" (trans p1 2 0) (trans p2 2 0))
            (if vpLock
              (command "_.mview" "_l" "_on" ent "")
            )
            (if vpNotActive
              (progn
                (command "_.pspace")
                (command "_.zoom" "_P")
                (command "._mspace")
              )
            )
          )
          (command "_.pspace")
          (command "_.undo" "_end")
        )
        (command "_.graphscr")
      )
    )
    (progn
      (princ "\n** Command not allowed in Model Tab **")
      (command "_.graphscr")
    )
  )
  (setvar "EXPERT" 0)
  (princ)
)

(defun makelay (LName LColor LType)
  (if (not(tblsearch "LAYER" LName))
    (entmake (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               (cons 2  LName) ;layer name
               (cons 6  (if (and LType (tblobjname "ltype" LType)) LType  "Continuous")) ;linetype
               (cons 62  LColor) ;layer color
               '(70 . 0) ; on, unlocked, thawed
               '(290 . 1) ;plotting flag
               '(370 . -3) ;lineweight
             )
    )
  )
)

(defun c:bvp (/ *error* ss p1 p2 id ent vpID clay)
  (defun *error* (errmsg)
    (while (> (getvar "CMDACTIVE") 0) (princ "\n***") (command))
    (setvar "EXPERT" 0)
    (setvar "CECOLOR" "BYLAYER")
    (if clay (setvar "CLAYER" clay))
    (princ "\n** ERROR **\n")
    (princ errmsg)(terpri)
    (command "_.undo" "_end")
    (princ)
  )
  (setvar "CMDECHO" 0)
  (setvar "EXPERT" 1)
  (if (= (getvar "TILEMODE") 0)
    (progn
      (if (/= (getvar "CVPORT") 1)
        (progn
          (command "._pspace")
          (princ "Switching to Paper space.")
        )
      )
      (if (or (setq ss (ssget "_I" '((0 . "VIEWPORT")))) (setq ss (ssget '((0 . "VIEWPORT")))))
        (progn
          (setq id -1)
          (command "_.undo" "_begin")
          (setq clay (getvar "CLAYER"))
          (makelay "vp-outline" 5 "Continuous")
          (command "._-layer" "_Plot" "_No" "vp-outline" "_Set" "vp-outline" "")
          (command "._vplayer" "_Vpvisdflt" "vp-outline" "_Frozen" "")
          (command "._vplayer" "_Freeze" "vp-outline" "_All" "")
          (repeat (sslength ss)
            (setq ent (ssname ss (setq id (1+ id))))
            (setq vpID (dxf 69 (entget ent)))
            (if (> vpID 1)
              (progn
                (setvar "CECOLOR" (rtos (dxf (dxf 410 (entget ent)) (layoutorderlist)) 2 0))
                (vpo ent)
                (if (not (tblsearch "APPID" "VPO"))
                  (regapp "VPO")
                )
                (entmod (append (entget (entlast)) (list (list -3 (list "VPO" (cons 1000 (dxf 410 (entget ent))))))))
              )
            )
          )
          (setvar "CECOLOR" "BYLAYER")
          (setvar "CLAYER" clay)
          (command "_.undo" "_end")
        )
        (command "_.graphscr")
      )
    )
    (progn
      (princ "\n** Command not allowed in Model Tab **")
      (command "_.graphscr")
    )
  )
  (setvar "EXPERT" 0)
  (princ)
)

(defun c:sbvp ( / )
  (sssetfirst nil (ssget "_X" '((0 . "LWPOLYLINE") (-3 ("VPO")))))
  (princ)
)

(defun c:gotovp ( / ss ent lay)
  (sssetfirst nil nil)
  (if (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-3 ("VPO")))))
    (progn
      (setq ent (ssname ss 0))
      (setq lay (cdr (car (cdr (assoc "VPO" (cdr (assoc -3 (entget ent '("*")))))))))
      (if (member lay (layoutlist))
        (setvar "CTAB" lay)
        (princ (strcat "\n** Error: Layout " lay " don't exist **"))
      )
    )
  )
  (princ)
)

;; Viewport Outline  -  Lee Mac
;; Generates an LWPolyline in Modelspace representing the outline of
;; a selected Paperspace Viewport. Compatible with all Rectangular
;; and Polygonal Viewports (including those with Arc segments), and
;; with all views & construction planes.

(defun vpo ( vpt / cen ent lst ocs vpe )

    (setq vpt (entget vpt))
    (if (setq ent (cdr (assoc 340 vpt)))
        (setq lst (LM: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)))
                     '((- -) (+ -) (+ +) (- +))
                  )
        )
    )
    (setq vpe (cdr (assoc -1 vpt))
          ocs (cdr (assoc 16 vpt))
    )
    (entmake
        (append
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
                (cons 90 (length lst))
               '(070 . 1)
               '(410 . "Model")
            )
            (apply 'append (mapcar '(lambda ( x ) (list (cons 10 (trans (pcs2wcs (car x) vpe) 0 ocs)) (cdr x))) lst))
            (list (cons 210 ocs))
        )
    )
    (princ)
)

;; Polyline Vertices  -  Lee Mac
;; Returns a list of vertices for a POLYLINE or LWPOLYLINE entity

(defun LM: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)
            )
        )
    )
)

;; 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)
)

(princ)

 

[kruszynski]

Myślałem że uda mi się znaleźć jakiś problem na poziomie kodu, ale wygląda OK. Mogę to przetestować jedynie na ZWCAD i tutaj działa. Nie wiem dlaczego w innej aplikacji jest problem.

[Noodles]

W autocadzie jest ok, w zwcadzie również. 

Natomiast problem pojawia się w GstarCadzie, tutaj pokazuje te viewporty na aktualnym layoucie, nie przenosi ich na model.