Noodles
-
Postów
3 -
Dołączył
-
Ostatnia wizyta
Odpowiedzi opublikowane przez Noodles
-
-
Załączam całość
Spoiler(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)
-
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?
Spoiler(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)
)
Viewport na modelu
w Wsparcie programistyczne LISP i VisualLISP
Opublikowano
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.