[ yêu cầu ] lisp khoá và mở khoá khung viewport !

[leejang 5]

Bác pro viết giúp em cái lisp khoá và mở khoá khung viewport với !

[vetgo 17]

Bạn lạm dụng Lisp quá rồi đấy :rolleyes:

Command: mv MVIEW

Specify corner of viewport or

[ON/OFF/Fit/Shadeplot/Lock/Object/Polygonal/Restore/2/3/4] <Fit>: l Viewport

View Locking [ON/OFF]: off

Select objects:

Lệnh của Cad nó cũng chỉ có thế, Lisp làm gì hở bạn!

[ketxu 2.984]

Bác pro viết giúp em cái lisp khoá và mở khoá khung viewport với !

Bạn hỏi ai vậy ? Bao năm post yêu cầu trên 4room rồi vẫn chưa đủ vốn để bạn làm điều đó sao HG ?

[Thaistreetz 539]

thực ra nếu nhu cầu cần fải lock/unlock là thường xuyên thì lệnh này sẽ cần thiết đấy. đọc yêu cầu mới nhận ra mình cũng cần lệnh này, tuy nhiên cần cải tiến cách thức 1 chút để dễ dàng làm việc với nó hơn.

Cụ thể ta sẽ viết lệnh này như 1 cái công tắc điện. nếu viewport đang khóa thì khi gõ lệnh nó sẽ được mở ra. và ngược lại, nếu viewport đang mở thì khi gõ lệnh nó sẽ được khóa lại.

Ý tưởng là thế, mình đang bận chưa viết được, các bác thử nghiên cứu xem <_<

[ketxu 2.984]

Vấn đề là cách đặt vấn đề của chủ topic thôi bác ạ, còn yêu cầu thì không có gì gọi là quá khó cả :unsure:

[ketxu 2.984]

Viewport Toggle chế độ DisplayLocked :

 

(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked
;======== Local Function =========
(defun ST:VP-Toggle-DisplayLocked (vpObj / rt)
;vp : vlaObject
;RT : T if Lock VP / nil if Open
(cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue))
	(T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer)))
)
;========== Start Here ==============
(grtext -1 "Free Lisp from Cadviet @Ketxu")
(cond
 ((< (atof (getvar "ACADVER")) 15.0)
  (alert " Lisp requires AutoCAD 2000 or higher. ")
 )
 ((or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
  (alert " Lisp can only be done in paper space. ")
 )
 ((and
   (not (prompt "\nSelect Viewport for (un)lock... "))
   (not (setq SelSet (ssget '((0 . "VIEWPORT")))))
  )
  (princ "Nothing or no Viewport selected.")
 )
 (T
  (vl-load-com)
  (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
 (ST:VP-Toggle-DisplayLocked vpObj)	 
   )
)
)
(princ)
)

P/s : sử dụng ActiveSS nhanh thật :)

[leejang 5]

Viewport Toggle chế độ DisplayLocked :

 

(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked
;======== Local Function =========
(defun ST:VP-Toggle-DisplayLocked (vpObj / rt)
;vp : vlaObject
;RT : T if Lock VP / nil if Open
(cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue))
	(T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer)))
)
;========== Start Here ==============
(grtext -1 "Free Lisp from Cadviet @Ketxu")
(cond
 ((< (atof (getvar "ACADVER")) 15.0)
  (alert " Lisp requires AutoCAD 2000 or higher. ")
 )
 ((or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
  (alert " Lisp can only be done in paper space. ")
 )
 ((and
   (not (prompt "\nSelect Viewport for (un)lock... "))
   (not (setq SelSet (ssget '((0 . "VIEWPORT")))))
  )
  (princ "Nothing or no Viewport selected.")
 )
 (T
  (vl-load-com)
  (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
 (ST:VP-Toggle-DisplayLocked vpObj)	 
   )
)
)
(princ)
)

P/s : sử dụng ActiveSS nhanh thật :)

hì. Em không biết cái lệnh mview kia vì e ko dùng lệnh đó bao h. Biết lệnh đó rùi thì e tự viết đc.

Gửi các bác, hic. làm j mà các bác mắng e ghê quá.

(defun C:lk() ; khóa khung layout

(SETQ SS (SSGET))

(command "mview" "L" "ON" SS "")

)

 

(defun C:ULK(); mở khóa khung layout

(SETQ SS (SSGET))

(command "mview" "L" "OFF" SS "")

)

[Thaistreetz 539]

Hàm ST:VP-Toggle-DisplayLocked ngon quá! thank sờ kiu :D

Nhưng nên là thế này thì phù hợp với thói quen sử dụng hơn ketxu ạ

(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked
;======== Local Function =========
(defun ST:VP-Toggle-DisplayLocked (vpObj / rt)
;vp : vlaObject
;RT : T if Lock VP / nil if Open
(cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue))
	(T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer)))
)
;========== Start Here ==============
(grtext -1 "Free Lisp from Cadviet @Ketxu")
(cond
 ((< (atof (getvar "ACADVER")) 15.0)
  (alert " Lisp requires AutoCAD 2000 or higher. "))
 ((= (getvar "TILEMODE") 1)   
  (alert " Lisp can only be done in paper space. "))
 ((> (getvar "CVPORT") 1)
  (ST:VP-Toggle-DisplayLocked (vlax-ename->vla-object (acet-currentviewport-ename))))
 ((and
   (not (prompt "\nSelect Viewport for (un)lock... "))
   (not (setq SelSet (ssget '((0 . "VIEWPORT"))))))
  (princ "Nothing or no Viewport selected."))
 (T
  (vl-load-com)
  (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
 (ST:VP-Toggle-DisplayLocked vpObj)	 
   )))
(princ)
)
)

[ketxu 2.984]

Tks bác vì ý tưởng toggle current Viewport ^^

Vậy ta sửa như thế này, tránh động chạm đến thằng ACET :

(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked
;======== Local Function =========
(defun ST:VP-Toggle-DisplayLocked (vpObj / rt)
;vp : vlaObject
;RT : T if Lock VP / nil if Open
(cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue))
	(T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer)))
)
;========== Start Here ==============
(grtext -1 "Free Lisp from Cadviet @Ketxu")
(cond
 ((< (atof (getvar "ACADVER")) 15.0)
  (alert " Lisp requires AutoCAD 2000 or higher. "))
 ((= (getvar "TILEMODE") 1)   
  (alert " Lisp can only be done in paper space. "))
 ((> (getvar "CVPORT") 1)
  (ST:VP-Toggle-DisplayLocked (vlax-ename->vla-object (ssname	(ssget "x" (list '(0 . "VIEWPORT") (cons 69 (getvar 'CVport)) (cons 410 (getvar 'CTab)))) 0))))
 ((and
   (not (prompt "\nSelect Viewport for (un)lock... "))
   (not (setq SelSet (ssget '((0 . "VIEWPORT"))))))
  (princ "Nothing or no Viewport selected."))
 (T
  (vl-load-com)
  (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
 (ST:VP-Toggle-DisplayLocked vpObj)	 
   )))
(princ)
)

@chủ topic : ngoài ra có thể pick vào biểu tượng hình cái khóa trên Status Bar

[bkhn_2011 1]

Tks bác vì ý tưởng toggle current Viewport ^^

Vậy ta sửa như thế này, tránh động chạm đến thằng ACET :

(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked
;======== Local Function =========
(defun ST:VP-Toggle-DisplayLocked (vpObj / rt)
;vp : vlaObject
;RT : T if Lock VP / nil if Open
(cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue))
	(T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer)))
)
;========== Start Here ==============
(grtext -1 "Free Lisp from Cadviet @Ketxu")
(cond
 ((< (atof (getvar "ACADVER")) 15.0)
  (alert " Lisp requires AutoCAD 2000 or higher. "))
 ((= (getvar "TILEMODE") 1)  
  (alert " Lisp can only be done in paper space. "))
 ((> (getvar "CVPORT") 1)
  (ST:VP-Toggle-DisplayLocked (vlax-ename->vla-object (ssname	(ssget "x" (list '(0 . "VIEWPORT") (cons 69 (getvar 'CVport)) (cons 410 (getvar 'CTab)))) 0))))
 ((and
   (not (prompt "\nSelect Viewport for (un)lock... "))
   (not (setq SelSet (ssget '((0 . "VIEWPORT"))))))
  (princ "Nothing or no Viewport selected."))
 (T
  (vl-load-com)
  (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
    (ST:VP-Toggle-DisplayLocked vpObj)     
   )))
(princ)
)

@chủ topic : ngoài ra có thể pick vào biểu tượng hình cái khóa trên Status Bar

Nhìn trình card của các bạn mà thèm. Câu hỏi có vẻ hơi thừa nhưng cho mình hỏi là mình đã load cái lisp của các bạn vào rồi. Đã báo thành công sau đó dùng lệnh gì để khóa hoặc mở khóa hả bạn.

[dung12789 0]

Sưu tầm được cái này: khóa mở nhanh tất cả các viewpor

thttp://www.cadviet.com/upfiles/3/65908_lv.lsp

[phandanghoa 3]

Sưu tầm được cái này: khóa mở nhanh tất cả các viewpor

thttp://www.cadviet.com/upfiles/3/65908_lv.lsp

Ôi thánh ăn gì em cúng, mỗi bản vẽ em có 100 layout tương uwnghs 100 cái viewport, may quá tìm ra cái này, thanksyou

[phuhvp 2]

Ôi thánh ăn gì em cúng, mỗi bản vẽ em có 100 layout tương uwnghs 100 cái viewport, may quá tìm ra cái này, thanksyou

Bác ơi, link die rồi, cảm phiền Bác down được rồi có thể up lên lại cho mọi người ko ạ, thanks

[victor85 10]

Lisp đây bác ơi:

;;; Function: Lock/Unlock Viewports
;;; Command Line: LV
;;; Description: By locking the Display you ensure your
;;; model view will not accidentally shift
;;; if you activate the viewport
;;;
;;; Developed by Theodorus Winata
;;; April 2006
;;;

(defun get-objects ()
(setq DPL (vlax-ename->vla-object (ssname SSG CNT))
    CNT (1+ CNT)
);;setq
);;get-objects

;;;********** Error Handler **********
(defun ERR (msg)
(princ)
);;ERR

;;;********** Main Program **********
(defun C:LV (/ CME CNT DPL *ERROR* OP SSG)
(vl-load-com)
(setq *ERROR* ERR
CME (getvar "CMDECHO")
);;setq
(setvar "CMDECHO" 0)
(if (= (getvar "TILEMODE") 1) (setvar "TILEMODE" 0))
(command "pspace")
(setq SSG (ssget "X" (list (cons 0 "VIEWPORT")))
    CNT 0
);;setq
(initget "Yes No")
(setq OP (getkword "Display locked [Yes/No] <Y>: "))
(cond
((or (= OP nil) (= OP "Yes"))
(repeat (sslength SSG)
(get-objects)    
    (vla-put-DisplayLocked DPL :vlax-true)
);;repeat
(prompt "\n\tAll Viewports Locked...!")
);;"Yes"
((= OP "No")
(repeat (sslength SSG)
    (get-objects)
    (vla-put-DisplayLocked DPL :vlax-false)
);;repeat
(prompt "\n\tAll Viewports Unlocked...!")
);;"No"
);;cond
(setvar "CMDECHO" CME)
(princ)
);;C:LV
(princ
(strcat
" LV.LSP v1.0 (Copyright 2006 by "
"\"Theo Winata and You\") loaded...!"
)
)
(princ)

[nguyenminh198 0]

Sưu tầm được cái này: khóa mở nhanh tất cả các viewpor

thttp://www.cadviet.com/upfiles/3/65908_lv.lsp

Cảm ơn thánh nhé

[unbroken 0]

Viewport Toggle chế độ DisplayLocked :

 

P/s : sử dụng ActiveSS nhanh thật 

[unbroken 0]

Lisp đây bác ơi:

;;; Function: Lock/Unlock Viewports

;;; Command Line: LV

;;; Description: By locking the Display you ensure your

;;; model view will not accidentally shift

;;; if you activate the viewport

;;;

;;; Developed by Theodorus Winata

;;; April 2006

;;;

 

(defun get-objects ()

(setq DPL (vlax-ename->vla-object (ssname SSG CNT))

    CNT (1+ CNT)

);;setq

);;get-objects

 

;;;********** Error Handler **********

(defun ERR (msg)

(princ)

);;ERR

 

;;;********** Main Program **********

(defun C:LV (/ CME CNT DPL *ERROR* OP SSG)

(vl-load-com)

(setq *ERROR* ERR

CME (getvar "CMDECHO")

);;setq

(setvar "CMDECHO" 0)

(if (= (getvar "TILEMODE") 1) (setvar "TILEMODE" 0))

(command "pspace")

(setq SSG (ssget "X" (list (cons 0 "VIEWPORT")))

    CNT 0

);;setq

(initget "Yes No")

(setq OP (getkword "Display locked [Yes/No] <Y>: "))

(cond

((or (= OP nil) (= OP "Yes"))

(repeat (sslength SSG)

(get-objects)    

    (vla-put-DisplayLocked DPL :vlax-true)

);;repeat

(prompt "\n\tAll Viewports Locked...!")

);;"Yes"

((= OP "No")

(repeat (sslength SSG)

    (get-objects)

    (vla-put-DisplayLocked DPL :vlax-false)

);;repeat

(prompt "\n\tAll Viewports Unlocked...!")

);;"No"

);;cond

(setvar "CMDECHO" CME)

(princ)

);;C:LV

(princ

(strcat

" LV.LSP v1.0 (Copyright 2006 by "

"\"Theo Winata and You\") loaded...!"

)

)

(princ)

Tuyệt vời! đây là cái mình cần . Thanks

[letuan0601 2]

Vào lúc 15/7/2016 tại 15:34, victor85 đã nói:

Lisp đây bác ơi:

;;; Function: Lock/Unlock Viewports
;;; Command Line: LV
;;; Description: By locking the Display you ensure your
;;; model view will not accidentally shift
;;; if you activate the viewport
;;;
;;; Developed by Theodorus Winata
;;; April 2006
;;;

(defun get-objects ()
(setq DPL (vlax-ename->vla-object (ssname SSG CNT))
    CNT (1+ CNT)
);;setq
);;get-objects

;;;********** Error Handler **********
(defun ERR (msg)
(princ)
);;ERR

;;;********** Main Program **********
(defun C:LV (/ CME CNT DPL *ERROR* OP SSG)
(vl-load-com)
(setq *ERROR* ERR
CME (getvar "CMDECHO")
);;setq
(setvar "CMDECHO" 0)
(if (= (getvar "TILEMODE") 1) (setvar "TILEMODE" 0))
(command "pspace")
(setq SSG (ssget "X" (list (cons 0 "VIEWPORT")))
    CNT 0
);;setq
(initget "Yes No")
(setq OP (getkword "Display locked [Yes/No] <Y>: "))
(cond
((or (= OP nil) (= OP "Yes"))
(repeat (sslength SSG)
(get-objects)    
    (vla-put-DisplayLocked DPL :vlax-true)
);;repeat
(prompt "\n\tAll Viewports Locked...!")
);;"Yes"
((= OP "No")
(repeat (sslength SSG)
    (get-objects)
    (vla-put-DisplayLocked DPL :vlax-false)
);;repeat
(prompt "\n\tAll Viewports Unlocked...!")
);;"No"
);;cond
(setvar "CMDECHO" CME)
(princ)
);;C:LV
(princ
(strcat
" LV.LSP v1.0 (Copyright 2006 by "
"\"Theo Winata and You\") loaded...!"
)
)
(princ)

Mình dùng Cad 2018. Load lisp cad nhận lệnh nhưng khi chon Y hoặc N thì khung nhìn không thay đổi chế độ khóa hoặc mở. Không biết do phiên bản 2018 hay lisp? Mong bạn giúp đỡ!