thiep

Lisp co kéo thanh thép có hệ lỗ, lệnh là CLP. Xem clip minh hoạ ở đây: Keocohelo.rar

Ý bạn là tạo lisp lưu đường dẫn chỉ đến 1 thư mục nào đó. Nhiều ngày sau, đánh lệnh lisp này thì nó sẽ chỉ đến thư mục hôm trước đã lưu phải không?

Thì ra là bị lừa, hộp thoại được thiết kế trong file chạy luôn. Xin lỗi Quocmanh nhe. He he he.

Bởi vì đâu có đọc được file vlx của quocmanh đâu. Chỉ thấy hộp thoại thôi.

Lỗi là lisp chưa thấy bạn copy file doslib.arx phù hợp (miễn phí) vào thư mục support của autocad. Hiện doslib đã có hỗ trợ đến cad2019. Bạn dùng cad 2020, quá hớp. Dùng lisp của quocmanh cũng được nhưng nếu ở 1 blockRef có ATT nhiều hơn 4 thì Thiep nghĩ lisp sẽ không phù hợp nữa.

Ui trời, lisp tiếp tục nhắc chọn các block có thuộc tính thì cứ chọn đi, chọn theo kiểu window từ dưới lên trên đi.

Lisp ở đây, lệnh là TBATT: Lisp sẽ yêu cầu nhiều câu: 1) Pick 1 block để lisp lấy tên thuộc tính, nếu pick không đúng, không phải là block hay block không có thuộc tính sẽ yêu cầu pick lại. 2) Thêm hay bớt .... 3) Chọn các block có thuộc tính để thay đổi. 4) * Nếu là thêm (t): lisp sẽ có 2 lần xuất hiện hộp thoại: 1 lần hỏi thêm tiền tố vào giá trị ATT, 1 lần hỏi thêm hậu tố vào giá trị ATT * Nếu là bớt (b): lisp sẽ có 2 lần xuất hiện hộp thoại: 1 lần hỏi: Xoá bao nhiêu chữ ở trước giá trị ATT; 1 lần hỏi: Xoá bao nhiêu chữ ở sau giá trị ATT Yêu cầu người dùng lisp phải copy file doslib vào thư mục support của autoCad: free ở trang https://wiki.mcneel.com/doslib/home ;;; LISP thêm bot string vào ATT ;;; by TrânThiêp 05/2020 ;;; 09188411230 (Defun loadDL (/ CPUxBit Name fullname bitD_L) (setq CPUxBit (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64") "x64" "" ) ) (setq Name (strcat "doslib" (substr (getvar "acadver") 1 2) CPUxBit ".arx")) (foreach sup (acet-str-to-list ";" (getvar "acadprefix")) (and (vl-string-search "\\support" sup) (findfile (setq fullname (strcat sup "\\" Name))) (vl-catch-all-error-p (vl-catch-all-apply 'arxload '(fullname))) (setq bitD_L T) ) ) bitD_L ) (defun sysvar-set (lst_setvar / strN var var_oldname n) (setq n 0 lstvar_thiep nil lstValue_thiep nil ) (repeat (/ (length lst_setvar) 2) (setq var (nth n lst_setvar) var_oldname (strcat "oldvar_thiep" (itoa n)) ) (setq lstvar_thiep (append lstvar_thiep (list var))) (set (read var_oldname) (getvar var)) (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname)))) (setvar var (nth (+ n 1) lst_setvar)) (setq n (+ 2 n)) ) ) (defun sysvar-restore () (mapcar '(lambda (var value) (setvar var (eval value))) lstvar_thiep lstValue_thiep ) ) (vl-load-com) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (acet-sysvar-restore) (command "undo" "en") (princ) ) ;;;=========================================================================== (defun c:tbatt (/ ss entlst entblk tag_lst TTnil bit TT_lst TH_lst tag_lst_new) (command "undo" "be") (sysvar-set '("cmdecho" 0 "osmode" 0)) (while (OR (NOT (setq entblk (car (entsel "\nPick 1 block \U+0111\U+1EC3 l\U+1EA5y thu\U+1ED9c tính c\U+1EE7a block" ) ) ) ) (NOT (eq (cdr (assoc 0 (entget entblk))) "INSERT")) (if (null (setq tag_lst (acet-insert-attrib-get entblk))) (progn (acet-ui-message "BLock này không có thu\U+1ED9c tính" "Prompt" 4144 ) ) ) ) (prompt "\nPick ch\U+01B0a \U+0111úng, vui lòng pick l\U+1EA1i") ) (setq TTnil nil) (mapcar '(lambda (x) (setq TTnil (append TTnil (list (list (car x) ""))))) tag_lst ) (initget "Them Bot") (if (eq (getvar "users1") "") (setvar "users1" "T") ) (if (= (setq bit (getstring (acet-str-format "\nThêm hay B\U+1EDBt t\U+1EEB vào giá tr\U+1ECB thu\U+1ED9c tính: ([T]hem / [B]ot) <%1> " (getvar "users1") ) ) ) "" ) (setq bit (getvar "users1")) ) (setvar "users1" bit) (acet-ui-status "Select Blockreferences" "Prompt") (setq ss (ssget '((0 . "INSERT")))) (setq entlst (acet-ss-to-list ss)) (acet-ui-status) (if (loadDL) (progn (cond ((= (strcase bit) "T") (setq TT_lst (dos_proplist "Change ATT value lisp by Trân Thiêp" "Thêm ti\U+1EC1n t\U+1ED1 vào các giá tr\U+1ECB thu\U+1ED9c tính (n\U+1EBFu có)" TTnil ) ) (setq HT_lst (dos_proplist "Change ATT value lisp by Trân Thiêp" "Thêm h\U+1EADu t\U+1ED1 vào các giá tr\U+1ECB thu\U+1ED9c tính (n\U+1EBFu có)" TTnil ) ) (mapcar '(lambda (e) (setq tag_lst_new nil) (mapcar '(lambda (x tt ht) (setq tag_lst_new (append tag_lst_new (list (list (car x) (strcat (cdr tt) (cadr x) (cdr ht) ) ) ) ) ) ) (acet-insert-attrib-get e) TT_lst HT_lst ) (acet-insert-attrib-set e tag_lst_new nil) ) entlst ) ) ((= (strcase bit) "B") (setq TT_lst (dos_proplist "Change ATT value lisp by Trân Thiêp" "Xoá b\U+1EDBt bao nhiêu ch\U+1EEF \U+1EDF tr\U+01B0\U+1EDBc giá tr\U+1ECB thu\U+1ED9c tính" TTnil ) ) (setq HT_lst (dos_proplist "Change ATT value lisp by Trân Thiêp" "Xoá b\U+1EDBt bao nhiêu ch\U+1EEF \U+1EDF sau giá tr\U+1ECB thu\U+1ED9c tính (n\U+1EBFu có)" TTnil ) ) (mapcar '(lambda (e) (setq tag_lst_new nil) (mapcar '(lambda (x tt ht) (setq tag_lst_new (append tag_lst_new (list (list (car x) (substr (if (>= (atof (cdr tt) ) 1 ) (setq str (substr (cadr x) (1+ (fix (atof (cdr tt))))) ) (setq str (cadr x) ) ) 1 (- (strlen str ) (fix (atof (cdr ht) ) ) ) ) ) ) ) ) ) (acet-insert-attrib-get e) TT_lst HT_lst ) (acet-insert-attrib-set e tag_lst_new nil) ) entlst ) ) ) ) ;_PROGN ) ;_IF (sysvar-restore) (command "undo" "en") (princ "\nOK") )

Có thể không cần dùng lisp. Trong express menu có 2 lệnh attout và attin: attout : xuất các giá trị thuộc tính ra file txt. Mở file txt này trong excel chỉnh sửa các giá trị thuộc tính này cho nhanh. Lưu file đã chỉnh sửa với đuôi txt. attin: update các giá trị thuộc tính bằng file txt vừa chỉnh sửa ở trên. Còn nếu dùng lisp thì Thiep cũng có lisp này, nhưng yêu cầu người dùng lisp phải copy thêm các file doslib vào trong thư mục support của autoCad. Các file doslib là file thư viện hàm hỗ trợ thêm để viết lisp, chép miễn phí ở trang web: https://wiki.mcneel.com/doslib/home

Đây không phải là block bị nổ mà Hatch bị nổ. Với những bản vẽ này giống như bvẽ chuyển từ các phần mềm khác như MicroStation sang Cad. Điều phải làm là: 1- Tách các đối tượng hatch bị nổ ra, tạo 1 lớp riêng, 2- Khoanh vùng trở lại các đối tượng này. 3- Tạo những pattern giống những đối tượng bị nổ trên. 4- Hatch trở lại các khoanh vùng trên. Bản vẽ của bạn tôi đã tách được vài lớp, công việc của bạn là khoanh vùng , tạo pattern và hatch trở lại. 1111.dwg

Lisp này phù hợp với ý @Luongquocsonxd và dành cho các kỹ sư xây dựng. Lisp có tạo 1 dimstyle là "kichthuoc", nếu sau khi chạy lisp thấy chưa phù hợp: textsize, textstyle, arrow ... thì vào lệnh dimsty để modify lại dimstyle này. Yêu cầu autoCad phải cài đặt thêm menu Express ;;; Lisp addDimAlign chia 1 line, lwpolyline thành 3 phân: 1/4L | 2/4L | 1/4L by Trân Thiêp ;;;================================================================ (defun DXF (code en) (cdr (assoc code (entget en)))) ;;;====================================================== (defun A_triangle (Pt1 Pt2 Pt3 / a b c p) (setq a (distance Pt1 Pt2) b (distance Pt2 Pt3) c (distance Pt3 Pt1) p (/ (+ a b c) 2) ) (sqrt (* p (- p a) (- p b) (- p c))) ) ;;;================================================================ (defun CalcZ (Pt1 Pt2 Pt3 / v w) (setq v (mapcar '- Pt1 Pt2) w (mapcar '- Pt3 Pt2) ) (- (* (car v) (cadr w)) (* (cadr v) (car w))) ) ;;;================================================================ (defun c:cdim (/ ApCad ActDoc *Model* *dimstyles* *TextStyles* *lay* ang dis po_dim po1 po2 prec objdimstyle lay newFontFile tsobj ss entlst hei_TDim Epo Spo ang Epara dis entname po_dim objdim1 objdim1A objdim2 objdim2B objdim3 objdim3A objdimstyle_th h bit ) (command "undo" "be") (defun *error* (msg) (and doc (_EndUndo doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (acet-sysvar-restore) (command "undo" "en") (princ) ) (acet-sysvar-set '("cmdecho" 0 "osmode" 1)) (setq ApCad (vlax-get-acad-object) ActDoc (vla-get-ActiveDocument ApCad) *Model* (vla-get-ModelSpace ActDoc) *TextStyles* (vla-get-TextStyles actDoc) *lay* (vla-get-layers actDoc) *dimstyles* (vla-get-dimStyles actDoc) ) (or (tblobjname "LAYER" "Kichthuoc") (vla-put-color (vla-add *lay* "Kichthuoc") 1) ) (setvar "clayer" "Kichthuoc") (setq newFontFile (acet-file-find-font "arial.TTF")) (if (not (tblobjname "STYLE" "Arial")) (progn (setq tsobj (vla-add *TextStyles* "Arial")) (vla-put-FontFile tsobj newFontFile) ) ) (setq ss (ssget '((0 . "LINE,LWPOLYLINE")))) (setq entlst (acet-ss-to-list ss)) (if (eq (getvar "users1") "0.0") (setvar "users1" "12.50") ) (if (null (setq hei_TDim (getreal (acet-str-format "\nEnter Height text dim : < %1 > " (getvar "users1") ) ) ) ) (setq hei_TDim (getvar "users1")) ) (if (numberp hei_TDim) (setvar "users1" (rtos hei_TDim)) (progn (setvar "users1" hei_TDim) (setq hei_TDim (atof hei_TDim))) ) (if (null (setq prec (getint (acet-str-format "\nEnter number of decimal places: < %1 > " (itoa (getvar "useri1")) ) ) ) ) (setq prec (getvar "useri1")) ) (setvar "useri1" prec) (if entlst (progn (foreach ent entlst (setq Epo (vlax-curve-getEndpoint ent) Spo (vlax-curve-getStartpoint ent) ang (angle Spo Epo) Epara (vlax-curve-getEndParam ent) dis (vlax-curve-getDistAtParam ent Epara) ) (setq entname (dxf 0 ent)) (setq po1 (vlax-curve-getPointatparam ent (vlax-curve-getParamAtdist ent (/ dis 4)) ) po2 (vlax-curve-getPointatparam ent (vlax-curve-getParamAtdist ent (* dis 0.75)) ) ) (setq po_dim (ACET-GEOM-MIDPOINT Spo po1)) (setq objdim1 (vla-AddDimAligned *Model* (vlax-3d-point Spo) (vlax-3d-point po1) (vlax-3d-point po_dim) ) ) (vla-put-TextHeight objdim1 hei_TDim) (vla-put-ArrowheadSize objdim1 (* hei_TDim 0.5)) (vla-put-PrimaryUnitsPrecision objdim1 prec) (vla-put-TextStyle objdim1 "Arial") (vla-put-VerticalTextPosition objdim1 acAbove) (setq objdim1A (vla-AddDimAligned *Model* (vlax-3d-point Spo) (vlax-3d-point po1) (vlax-3d-point po_dim) ) ) (vla-put-TextOverride objdim1A "A") (vla-put-VerticalTextPosition objdim1A acUnder) (vla-put-TextHeight objdim1A hei_TDim) (vla-put-TextStyle objdim1A "Arial") (if (not objdimstyle_th) (progn (vla-put-ScaleFactor objdim1 1) (vla-put-textGap objdim1 (* hei_TDim 0.7)) (vla-put-ExtLine1Suppress objdim1 :vlax-false) (vla-put-ExtLine2Suppress objdim1 :vlax-false) (vla-put-DimLine1Suppress objdim1 :vlax-false) (vla-put-DimLine2Suppress objdim1 :vlax-false) (vla-put-Arrowhead1Type objdim1 acArrowArchTick) (vla-put-Arrowhead2Type objdim1 acArrowArchTick) (vla-put-TextPrefix objdim1 "") (vla-put-TextSuffix objdim1 "") (vla-put-TextInsideAlign objdim1 :vlax-false) (if (not (tblobjname "dimstyler" "kichthuoc")) (setq objdimstyle_th (vla-add *dimstyles* "kichthuoc" ) ) ) (vla-CopyFrom objdimstyle_th objdim1) (if objdimstyle_th (vla-put-activeDimstyle ActDoc objdimstyle_th) (vla-put-activeDimstyle ActDoc (vla-item *dimstyles* "kichthuoc") ) ) ) ) (setq po_dim (ACET-GEOM-MIDPOINT po1 po2)) (setq objdim2 (vla-AddDimAligned *Model* (vlax-3d-point po1) (vlax-3d-point po2) (vlax-3d-point po_dim) ) ) (vla-put-PrimaryUnitsPrecision objdim2 prec) (vla-put-TextHeight objdim2 hei_TDim) (setq objdim2B (vla-AddDimAligned *Model* (vlax-3d-point po1) (vlax-3d-point po2) (vlax-3d-point po_dim) ) ) (vla-put-TextOverride objdim2B "B") (vla-put-VerticalTextPosition objdim2B acUnder) (vla-put-TextHeight objdim2B hei_TDim) (setq po_dim (ACET-GEOM-MIDPOINT po2 Epo)) (setq objdim3 (vla-AddDimAligned *Model* (vlax-3d-point po2) (vlax-3d-point Epo) (vlax-3d-point po_dim) ) ) (vla-put-PrimaryUnitsPrecision objdim3 prec) (vla-put-TextHeight objdim3 hei_TDim) (setq objdim3A (vla-AddDimAligned *Model* (vlax-3d-point po2) (vlax-3d-point Epo) (vlax-3d-point po_dim) ) ) (vla-put-TextOverride objdim3A "A") (vla-put-VerticalTextPosition objdim3A acUnder) (vla-put-TextHeight objdim3A hei_TDim) (While (= 5 (car (setq gr (grread 't 13 0)))) (redraw) (setq p3 (trans (cadr gr) 1 0)) (setq h (/ (* (A_triangle Spo p3 po1) 2) (distance Spo po1)) ) (setq bit (calcz Spo P3 po1)) (if (> bit 0) (setq an (+ ang (/ pi 2))) (setq an (- ang (/ pi 2))) ) (setq potext1 (polar (acet-geom-midpoint Spo po1) an h)) (setq potext2 (polar (acet-geom-midpoint po1 po2) an h)) (setq potext3 (polar (acet-geom-midpoint po2 Epo) an h)) (vla-put-TextPosition objdim1 (vlax-3d-point potext1)) (vla-put-TextPosition objdim1A (vlax-3d-point potext1)) (vla-put-TextPosition objdim2 (vlax-3d-point potext2)) (vla-put-TextPosition objdim2B (vlax-3d-point potext2)) (vla-put-TextPosition objdim3 (vlax-3d-point potext3)) (vla-put-TextPosition objdim3A (vlax-3d-point potext3)) ) ) (acet-sysvar-restore) (Setq xinchao (vl-list->string '(72 101 108 108 111 32 101 118 101 114 121 98 111 100 121 46 32 77 121 32 110 97 109 101 32 84 114 97 110 32 84 104 105 101 112 ) ) ) ) ) (command "undo" "en") (princ xinchao) (princ) ) Lisp thể hiện những dimension còn "động đậy" cho đến khi người dùng pick điểm phù hợp đặt vị trí để cố định dimension.

Lisp này mình mới vừa đăng cách nay gần 1 tháng, chịu khó tìm là có: ;;; lisp convert curve: ARC, CIRCLE, ELLIPSE, SPLINE to Lwpolyline ;;; by Trân Thiêp 0918841230 (defun DXF (code en) (cdr (assoc code (entget en)))) (defun c:c2pl (/ ss lstpo obj) (command "undo" "be") (and (not ACET-GEOM-SPLINE-POINT-LIST) (findfile "acetutil.arx") (arxload (findfile "acetutil.arx") "Failed to Load Express Tools") ) (defun curve->Lstpo (ent num / LL_UR) (setq LL_UR (acet-ent-geomextents ent)) (ACET-GEOM-SPLINE-POINT-LIST ent (/ (distance (car LL_UR) (cadr LL_UR)) num) ) ) (acet-error-init '(("cmdecho" 0 "osmode" 0 "PLINEGEN" 1) 1 (acet-ui-status))) (acet-ui-status "\nSelect curves to convert it into Lwpolylines" "PROMPT") (while (NOT (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE"))))) (acet-ui-status "\nSelect arn't right, please select curves again" "PROMPT") ) (acet-ui-status) (mapcar '(lambda (x) (cond ((wcmatch (acet-dxf 0 (entget x)) "ARC,CIRCLE,ELLIPSE") (acet-Lwpline-make (list (curve->Lstpo x 2020))) ) (T (acet-Lwpline-make (list (curve->Lstpo x 3000)))) ) (setq obj (vlax-ename->vla-object (entlast))) (if (dxf 6 x)(Vla-put-Linetype obj (dxf 6 x))) (if (dxf 48 x) (Vla-put-LinetypeScale obj (dxf 48 x)) ) (Vla-put-LinetypeGeneration obj :vlax-true) (Vla-put-layer obj (dxf 8 x)) (if (setq col (dxf 62 x)) (Vla-put-color obj col) (Vla-put-color obj 256) ) (entdel x) ) (acet-ss-to-list ss) ) (acet-error-restore) (command "undo" "en") (princ "\nOk") )

Hi @lethanh2004, bản vẽ của bạn rất giống với lisp của nguyen thanhduan, bạo vào đây xem và liên hệ với tác giả:

Hết cách ly xã hội vì con virus Vũ Hán, đi làm lại, bây giờ ít rãnh rồi.