naturooo

Trước khi in làm cái cho đỡ quên up :D ;;===============SUPER UP DIM, UP TEXT THEO VIEWPORT======================================= (defun c:SUP( / oldCmdEcho listVPorts itemVPort ss ssl temp ed old new ) (vl-load-com) (setq oldCmdEcho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq currentLayout (getvar "ctab")) (setvar "CTAB" "Model") (command "_.ucs" "w");Ve lai Model va dat lai UCS ve World (foreach lay (layoutlist) (setvar "CTAB" lay) (if (/= (getvar "CTAB") "Model") (progn (command "zoom" "all") (setq listVPorts (vl-sort (vports) '(lambda(v1 v2) (< (car v1) (car v2))))) (if (> (length listVPorts) 1) (progn (command "_MSPACE") (foreach itemVPort (cdr listVPorts) (setvar "CVPORT" (car itemVPort)) ; (vpsel "W") (setq ent (vlax-vla-object->ename (vla-get-activepviewport (vla-get-activedocument (vlax-get-acad-object))))) (setq cvscale (vla-get-customscale (vlax-ename->vla-object ent))) (setvar "dimscale" (/ 1 cvscale)) (setq cvscale (strcat "D" (rtos (/ 1 cvscale) 2 0))) (if (not (tblsearch "DIMSTYLE" cvscale)) (command "-DIMSTYLE" "s" cvscale) (command "-DIMSTYLE" "r" cvscale) ) (setq SCALE (getvar "dimscale")) ; (command "DIM1" "UP" "P" "") (vpsel "W") (c:UP) ) (command "_PSPACE") ) (prompt "\nThere are no viewports defined in this Layout!") ) ) (prompt "\nThis routine works only in Layout!") ) );END foreach (setvar "CMDECHO" oldCmdEcho) (setvar "CTAB" currentLayout) (princ) ) ;===================================================================================== ;https://lispbox.wordpress.com/2015/05/05/selecting-objects-within-viewport-and-copy-it-to-clipboard-by-selecting-a-ps-viewport/ ;;; vpsel.lsp ; By Jimmy Bergmark ; Copyright (C) 1997-2006 JTB World, All Rights Reserved ; Website: http://www.jtbworld.com (http://www.jtbworld.com) ; E-mail: info@jtbworld.com ; 2000-04-14 - First release ; Tested on AutoCAD 2000 ; DESCRIPTION ; Select all visible objects in selected or active paperspace viewport Works transparently when in modelspace and for polygonal viewports too ; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ; Example2: (command "erase" "all" "r" (c:vpc) "") ; Example3: VPC ERASE >>> VPC is run previous the command and the objects are also in previous selection set ; c:vpc - select all visible objects with crossing in viewport ; c:vpw - select all visible objects with window in viewport ; Phai dua UCS ve World ****************************************************************************************************************************************** (defun vpsel (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr pl nlist x n) (vl-load-com) (setq ok t) (if (= (getvar "tilemode") 0) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (if (= (getvar "cvport") 1) (if (and (= (getvar "cmdactive") 0) (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil)) (progn (setq ent (ssname ss 0)) (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno)) (progn (setq ok nil) (princ))) (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad)))) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)))) (progn (setq pl (entget (dxf 340 (entget ent)))) (setq nlist nil) (foreach x pl (if (eq 10 (car x)) (setq nlist (cons (trans (cdr x) 3 2) nlist)))) (setq ss1 (ssget (strcat typ "P") nlist)))) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0)) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 (princ))) (princ))) (princ))) ;============================================================================================= https://www.youtube.com/watch?v=ywKjGk7k8lo

Mà chắc bạn cũng chưa hiểu bác Nhân nói về cái clip đâu nhỉ.

Bác ấy cần file cad mẫu để kiểm tra lisp chạy thê nào. Đọc lại cmt bác thiep chưa?

Nên xem lại cách hỏi, xem hiểu, đọc hiểu đi bạn. Tây hay ta nào cũng vậy, gửi cái file mẫu lên cho ai muốn giúp thì còn có hứng giúp. Mỗi cái ảnh ngó thấy ai thèm giúp cho. Thấy bác thiệp nói ở trên không. Còn bác DUngNguyen685 thì cũng teamview sửa lỗi lisp không chạy đúng trên máy bạn. Hai bác nhiệt tình free vậy còn tự ái gì nữa. Không ngáo ngáo à?

Ngáo ngáo kiểu gì ấy.

Có thể giải pháp cấp cho họ tọa giới hạn window hiện hành để họ đưa vào lệnh zoom/window trên máy họ.

Chung file xref chứ sao mở cùng 1 file mà làm chung được nhỉ???

Qua bên layout vẽ đường xl qua vị trí chi tiết cần zoom. Qua bên model xóa hết mấy block vớ vẩn đi. Mình làm rồi mới nói chứ không nói cho vui với bạn đâu. Không xóa đi thì zoom đến mai cũng chẳng thấy được.

Thực ra không phải không nhìn thấy mà nhóm đối tượng của bạn quá bé thôi. Do lỗi nào đó mà mấy cái block thành các điểm rất xa nhau. Sửa lại block lỗi hoặc xóa nó đi nếu không cần thì zoom thấy thôi.

Sao bác không chụp cả rồi crop đi. Em toàn dùng luôn tiện ích chụp của Zalo luôn :D

Bản tải lại thử xem nhé

Đây nhé bạn: ;; List Box - Lee Mac ;; Displays a DCL list box allowing the user to make a selection from the supplied data. ;; msg - [str] Dialog label ;; lst - [lst] List of strings to display ;; bit - [int] 1=allow multiple; 2=return indexes ;; Returns: [lst] List of selected items/indexes, else nil (defun LM:listbox (msg lst bit / dch des tmp rtn) (cond ((not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false" ) ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) (t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (mapcar '(lambda (x) (nth x lst)) (read (strcat "(" rtn ")")) ) (read (strcat "(" rtn ")")) ; (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn ) ;====================================Main Lisp: Quick Filter (QF) Update 19/08/2020 Loc theo "True Color"====================================== (defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn txtvl lstQF lstDCL lstidx dimsty lstfi a c d l ) (setq ss1 (entsel "\nSelect Object: ")) (while (or (null ss1) (= "" (cdr (assoc 0 (entget (car ss1))))) ) (setq ss1 (entsel "\nSelect Object Again: ")) ) (setq ss (entget (car ss1))) (setq ob (cdr (assoc 0 ss))) (setq lstQF (list (cons 0 ob))) (if (= "INSERT" ob) (setq lstDCL (list (strcat "Object : " "Block"))) (setq lstDCL (list (strcat "Object : " ob))) ) ;endif (setq lyrname (cdr (assoc 8 ss))) (setq lstQF (append lstQF (list (cons 8 lyrname)))) (setq lstDCL (append lstDCL (list (strcat "Layer : " lyrname)) ) ) (setq c (cond ((cdr (assoc 62 ss))) ((abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ss))))) ) ) ) ) (while (setq d (tblnext "LAYER" (null d))) (if (= c (abs (cdr (assoc 62 d)))) (setq l (cons "," (cons (cdr (assoc 2 d)) l))) ) ) (setq lstQF (append lstQF (list "True Color"))) (setq lstDCL (append lstDCL (list (strcat "True Color : " (rtos c 2 0))) ) ) (if (= 2 (car (assoc 2 ss))) (progn (setq blkname (cdr (assoc 2 ss))) (setq lstQF (append lstQF (list (cons 2 blkname)))) (setq lstDCL (append lstDCL (list (strcat "Block Name : " blkname)) ) ) ) ;end progn ) ;end if (if (= 40 (car (assoc 40 ss))) (progn (setq txth (cdr (assoc 40 ss))) (setq lstQF (append lstQF (list (cons 40 txth)))) (setq lstDCL (append lstDCL (list (strcat "Text Height : " (rtos txth))) ) ) ) ;end progn ) ;end if (if (= 7 (car (assoc 7 ss))) (progn (setq txtn (cdr (assoc 7 ss))) (setq lstQF (append lstQF (list (cons 7 txtn)))) (setq lstDCL (append lstDCL (list (strcat "Text Style Name : " txtn)) ) ) ) ;end progn ) ;end if (if (= 1 (car (assoc 1 ss))) (progn (setq txtvl (cdr (assoc 1 ss))) (setq lstQF (append lstQF (list (cons 1 txtvl)))) (setq lstDCL (append lstDCL (list (strcat "Text Value : " txtvl)) ) ) ) ;end progn ) ;end if (if (= 3 (car (assoc 3 ss))) (progn (setq dimsty (cdr (assoc 3 ss))) (setq lstQF (append lstQF (list (cons 3 dimsty)))) (setq lstDCL (append lstDCL (list (strcat "Dimension Style : " dimsty)) ) ) ) ;end progn ) ;end if (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1)) (if lstidx (progn (foreach a lstidx (if (= "True Color" (nth a lstQF)) (if l (setq lstfi (append lstfi (list (cons -4 "<OR") (cons 62 c) (cons -4 "<AND") (cons 62 256) (cons 8 (apply 'strcat (cdr l))) (cons -4 "AND>") (cons -4 "OR>") ) ) ) (setq lstfi (append lstfi (list (cons 62 c)) ) ) ) (setq lstfi (append lstfi (list (nth a lstQF)))) ) ) (sssetfirst nil) ; clear original-selection highlighting/gripping, then: (sssetfirst nil (ssget lstfi)) ) ) (Print "Write by: NghiaKieu") (princ) )

Cái này dùng NXsoft chạy trên Civil 3D nhé bạn

Thay vì lệnh Filter (FI) mặc định chọn rồi xoá xoá. Lisp Quick Filter (QF) này sẽ chọn một số thuộc tính thông dụng để lọc, giảm bớt vài thao tác thừa không cần thiết: ;; List Box - Lee Mac ;; Displays a DCL list box allowing the user to make a selection from the supplied data. ;; msg - [str] Dialog label ;; lst - [lst] List of strings to display ;; bit - [int] 1=allow multiple; 2=return indexes ;; Returns: [lst] List of selected items/indexes, else nil (defun LM:listbox ( msg lst bit / dch des tmp rtn ) (cond ( (not (and (setq tmp (vl-filename-mktemp nil nil ".dcl")) (setq des (open tmp "w")) (write-line (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select=" (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}" ) des ) (not (close des)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch) ) ) (prompt "\nError Loading List Box Dialog.") ) ( t (start_list "list") (foreach itm lst (add_list itm)) (end_list) (setq rtn (set_tile "list" "0")) (action_tile "list" "(setq rtn $value)") (setq rtn (if (= 1 (start_dialog)) (if (= 2 (logand 2 bit)) (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) (read (strcat "(" rtn ")")) ; (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")"))) ) ) ) ) ) (if (< 0 dch) (unload_dialog dch) ) (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp) ) rtn ) ;====================================Main Lisp: Quick Filter (QF)====================================== (defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn lstQF lstDCL lstidx lstfi a) (setq ss1 (entsel "\nSelect Object: ")) (while (or (null ss1) (= "" (cdr (assoc 0 (entget (car ss1))))) ) (setq ss1 (entsel "\nSelect Object Again: ")) ) (setq ss (entget (car ss1))) (setq ob (cdr (assoc 0 ss))) (setq lstQF (list (cons 0 ob))) (if (= "INSERT" ob) (setq lstDCL (list (strcat "Object : " "Block"))) (setq lstDCL (list (strcat "Object : " ob))) );endif (setq lyrname (cdr (assoc 8 ss))) (setq lstQF (append lstQF (list (cons 8 lyrname)))) (setq lstDCL (append lstDCL (list (strcat "Layer : " lyrname)))) (if (= 62 (car (assoc 62 ss))) (progn (setq colr (cdr (assoc 62 ss))) (setq lstQF (append lstQF (list(cons 62 colr)))) (setq lstDCL (append lstDCL (list (strcat "Color : " (rtos colr 2 0))))) );progn (progn (setq lstQF (append lstQF '((62 . 256)))) (setq lstDCL (append lstDCL (list (strcat "Color : " "256")))) ) ) ;end if (if (= 2 (car (assoc 2 ss))) (progn (setq blkname (cdr (assoc 2 ss))) (setq lstQF (append lstQF (list (cons 2 blkname)))) (setq lstDCL (append lstDCL (list (strcat "Block Name : " blkname)))) );end progn ) ;end if (if (= 40 (car (assoc 40 ss))) (progn (setq txth (cdr (assoc 40 ss))) (setq lstQF (append lstQF (list (cons 40 txth)))) (setq lstDCL (append lstDCL (list (strcat "Text Height : " (rtos txth))))) );end progn ) ;end if (if (= 7 (car (assoc 7 ss))) (progn (setq txtn (cdr (assoc 7 ss))) (setq lstQF (append lstQF (list (cons 7 txtn)))) (setq lstDCL (append lstDCL (list (strcat "Text Style Name : " txtn)))) );end progn ) ;end if (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1)) (foreach a lstidx (setq lstfi (append lstfi (list (nth a lstQF)))) ) (sssetfirst nil (ssget lstfi)) (Print "Write by: NghiaKieu") (princ) )