thiep
-
Số lượng nội dung
514 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
48
Bài đăng được đăng bởi thiep
-
-
1 giờ} trướ}c, hawking312 đã nói:Cảm ơn bác đã giúp đỡ, có thể bỏ bảng thông báo này mà thay bằng dòng command phía dưới cho dễ chịu và tăng tốc hơn được không bác, xin cảm ơn bác nhiều.
;;; LISP convert ARC, CIRCLE, ELLIPSE, SPLINE to LWPOLYLINE ;;; By Trân Thiêp 0918.841230 ;;; 05/2020. (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) ) ) (defun c:c2pl (/ ss lstpo obj col Ltype LtypeScale) (command "undo" "be") (acet-error-init '(("cmdecho" 0 "osmode" 0) 0)) (or ucshold_thiep (setq ucshold_thiep (acet-ucs-get nil))) (acet-ucs-cmd '("w")) (PROMPT "\nSelect curves to convert it into Lwpolylines" ) (while (NOT (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,SPLINE"))))) (PROMPT "\nSelect arn't right, please select curves again" ) ) (mapcar '(lambda (x) (setq eng (entget x)) (cond ((wcmatch (acet-dxf 0 eng) "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 (setq Ltype (acet-dxf 6 eng)) (Vla-put-Linetype obj Linetype)) (if (setq LtypeScale (acet-dxf 48 eng)) (Vla-put-LinetypeScale obj LtypeScale)) (Vla-put-LinetypeGeneration obj :vlax-true) (Vla-put-layer obj (acet-dxf 8 eng)) (if (setq col (acet-dxf 62 eng)) (Vla-put-color obj col)) (entdel x) ) (acet-ss-to-list ss) ) (acet-ucs-set ucshold_thiep) (acet-error-restore) (command "undo" "en") (princ "\nOk") (princ) )Thử lại xem bạn. Nhân tiện fix luôn 1 lỗi nhỏ về color của đối tượng.
-
Vào lúc 11/5/2020 tại 11:42, dinhtuong18 đã nói:Nhờ các anh trong cộng đồng cadviet giúp em viết lisp với ạ
Em có một hình chữ nhật cho trước,bên trong hình chữ nhật có các hệ lỗ đã được chia khoảng cách cho trước,giờ em muốn kéo giãn hay co ngắn hình chữ nhật đấy thì các hệ lỗ bên trong cũng sẽ tăng lên hoặc giảm đi và chia đều như các khoảng cách cho trước ạ
Em cảm ơnLisp co kéo thanh thép có hệ lỗ, lệnh là CLP. Xem clip minh hoạ ở đây:
-
1
-
-
4 giờ trước, GIRLXAYDUNG đã nói:Xin chào tất cả mọi người, em có một vướng mắc mong mọi người giúp đỡ ạ.Tình hình là công việc của em chủ yếu là vẽ Cad em hay mở một số thư mục cố định (có thể sâu bên trong) thường xuyên để lấy thông tin cần thiết, em biết có thể mở ra để trước nhiều thư mục cần thiết để trước nhưng nhìn rất rối.
Nay xin mạn phép nhờ mọi người viết 1 Lisp mở nhanh các thư mục con bằng cách nhập lệnh được không ạ (thư mục có thể tự thay đổi theo đường dẫn); em lấy thông tin xong rồi đóng lại, mỗi lần dùng lại đánh lệnh để mở thư mục cần thiết thôi.Em cảm ơn ạ, chúc mọi người sức khỏe.
Ý 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?
-
1
-
-
20 phút trước, quocmanh04tt đã nói:VLX thì đúng là bình thường không đọc được, nhưng vẫn có thể test. Nếu bác nói 40 ATT thì có thể, vì khi đó hộp thoại nó quá dài...
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.
-
12 phút trước, quocmanh04tt đã nói:Chắc bác chỉ mới xem hình hoặc video thì bác mới quả quyết vậy!
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.
-
1
-
1
-
-
1 giờ trước, hongoanh93 đã nói:Dạ, cháu cảm ơn chú nhiều ạ, cháu làm theo hướng dẫn của chú, đánh lệnh --> chọn đối tượng block att--> thêm hoặc bớt (T hoặc B)---> mà nó báo như thế này, cháu đợi lâu quá click vào block att thì không có hiện tượng gì nữa cả ạ, mong chú xem xét ạ
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.
-
1
-
-
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") )
-
1
-
-
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:
-
1
-
-
Đâ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.
-
Vào lúc 24/4/2020 tại 14:47, Luongquocsonxd đã nói:Mình nhờ anh em bên diễn đàn giúp mình đoạn lisp thực hiện công việc như hình vẽ mình gửi. Cảm ơn nhiều!
Bài liên quan:-
Mẹo vặt với Computer - Thảo luận vỉa hè
Hãy bình tĩnh và làm theo mẹo nhỏ dưới đây, bạn sẽ tiết kiệm được khá nhiều thời gian đấy! ... Add scheduled task: thêm các nhiệm vụ do bạn tự ấn định. ... Windows + Pause/Break: Với những người nâng cấp và điều chỉnh phần ... Anh muốn phát âm vào ô Use the following text to preview the voice rồi ...
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.
-
-
46 phút trước, hawking312 đã nói:Như tiêu đề ạ, em có việc muốn chuyển các đường cong hoặc hình tròn thành các đa giác. Em thấy có app tương tự của Autodesk nhưng có tính phí, mong các tiền bối giúp đỡ.
Link Autodesk:
CIR2VECT – Circle to Vectored polygonARCVECT – Arc, PolyArc and Circle Vectorizer
Video ví dụ
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") )-
1
-
-
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ả:
-
3 giờ trước, M se đã nói:Cảm ơn anh. Khi nào anh rãnh viết giúp em với..hihi
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.
-
2 giờ trước, quocmanh04tt đã nói:Viết cho bạn, xem có đúng ý không???
(defun c:tt (/ els ent fn fw id ins pnt ss zco)
(cond ((and (setq ss (ssget '((0 . "TEXT") (8 . "Docao"))))
(setq fn (getfiled "Nhap the file" (getvar 'DWGPREFIX) "txt" 1)))
(setq fw (open fn "w")
id 0)
(write-line "STT\tTOA DO-X\tTOA DO-Y\tTOA DO-Z" fw)
(while (and (setq ent (ssname ss 0)) (ssdel ent ss))
(if (setq zco (distof (cdr (assoc 1 (setq els (entget ent))))))
(progn (setq ins (cdr (assoc 10 els))
pnt (list (- (car ins) 0.225) (cadr ins) zco))
(write-line (apply 'strcat
(cons (itoa (setq id (1+ id)))
(mapcar '(lambda (x) (strcat "\t" (rtos x 2 2))) pnt)))
fw))))
(close fw)))
(princ)) 1 giờ} trướ}c, PhamYen đã nói:Do khi nâng cao độ text bạn không nâng cao độ đường tròn lên nó chênh lệch là phải rồi . bạn chỉ cần giảm cao độ trong file text đi 2.483 là được . còn không bạn dung lsp của bác
Quocmanh04tt cũng rất hay
Vô tình bản vẽ này là ở chỗ toạ độ X của text cao độ - 0.225 là toạ độ X của tâm vòng tròn (điểm đo địa hình). Với những bản vẽ khác, text độ cao sẽ dịch chuyển rất tự do xung quanh điểm đo thì lisp của @quocmanh04tt , hay phải giảm cao độ trong file text đi 2.483 như @PhamYen nói sẽ không chính xác. Có khi gây sai sót lớn cho việc làm báo cáo kết quả đo đạc.
Có nhiều vấn đề cho loại hình bản vẽ này:
1. Với cao độ Z: bên trắc địa đo chi tiết rất dày đặc, text cao độ chồng chất nhau, nên không thể lấy tâm vòng tròn để dò tìm text cao độ gần nó nhất. Thiệp đã có lisp xuất điểm đo chi tiết kiểu này từ lâu rồi, nhưng cũng rất cẩn thận với mấy nhà trắc địa đo đạc quá dày đặc. Trong trường hợp này, trước tiên phải chạy 1 lisp khác, lisp này sẽ tạo 1 "đường tròn" với 1 bán kính ảnh hưởng tối ưu tại điểm đo để dò tìm các text cao độ ở gần điểm đo chi tiết:
a) Nếu phát hiện có > 2 text chồng chất thì khoanh tròn vị trí này. Người dùng tay move các text cao độ chồng chất đi chỗ khác ra khỏi khoang tròn này, hoặc bằng nhiều cách miễn là chỉ để 1 text cao độ trong khoang tròn mà thôi.
b) Nếu không tìm 1 text cao độ nào cũng khoanh tròn điểm đo này để người dùng "chế" thêm text cao độ, hoặc thay đổi "bán kính ảnh hưởng để chạy lại lisp
2. Với toạ độ X, Y: Đối tượng điểm đo là loại gì: block, point, circle... hay tổng hợp nhiều loại đối tượng thể hiện điểm đo, từ đó mới dùng ssget để tìm toạ độ X, Y điểm chèn của điểm đo.
Một số tổng quát để viết lisp này vậy.
-
1
-
-
3 giờ trước, alisp đã nói:Bình thường mà bạn chỉ dư chữ </yes> ở cuối thôi.
Đúng là dư chữ </yes> ở cuối lisp. Ngoài ra, lisp này không có gì sai, chỉ có một vài điều như sau:
- Lisp phải yêu cầu cad 2005 trở lên mới tạo được Table,
- Lisp thống kê tên block quá nhiều block tên là *U...., cần phải truy đến tên thực của nó, vì tên *U... có thể là do block dynamic đẻ ra.
-
Nhìn chung đề bài cũng rõ ràng, các mặt cắt cũng khá giống nhau về mặt cắt, chỉ khác chi tiết đai, cốt thép và tên mặt cắt: 1-1, 2-2, 3-3... phải không @xaydungcadviet
Trường hợp 3, lấy "điểm chuẩn" là tâm cạnh đáy dầm: đây là 1 đường lwpolyline, một lớp riêng biệt ("kata net thay") nên cũng thuận lợi dò tìm các "điểm chuẩn" khác để move nhóm đối tượng khác theo khoảng cách của người dùng yêu cầu.
-
1
-
-
Lisp này chắc phù hợp ý của @nguyen hai son
(defun lstpoint (/ ptemp PT lstp) (setq lstp (list (setq PT (getpoint "\nPick the first point ")))) (setq ptemp pt) (while (setq PT (getpoint ptemp "\nPick the next point ")) (grdraw ptemp PT 8 1) (setq lstp (append lstp (list pt))) (setq ptemp pt) ) lstp ) (defun SetClipBoardText (text / htmlfile result) ; By XShrimp (if (= 'STR (type text)) (progn (setq htmlfile (vlax-create-object "htmlfile") result (vlax-invoke (vlax-get (vlax-get htmlfile 'ParentWindow) 'ClipBoardData ) 'SetData "Text" text ) ) (vlax-release-object htmlfile) text ) ) ) (defun GetArea (lst ) (/ (apply '+ (mapcar '(lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) lst (cons (last lst) lst) ) ) 2 ) ) (defun c:getA (/) (command "undo" "be") (acet-sysvar-set '("cmdecho" 0 "osmode" 545)) (SetClipBoardText (rtos (abs (GetArea (lstpoint))))) (command "_pasteclip") (acet-sysvar-restore) (redraw) (command "undo" "en") (princ "\nOk") ) -
1 giờ trước, Biet ve CAD đã nói:Bắt được con Kiến rồi, giờ bắt tiếp con Voi to hơn thử xem có được không ^^
Hề hề hề, tất cả dữ liệu đề bài đưa ra đều làm được.
Việc định danh tên block "làm tâm" hay việc lấy dữ liệu ngoài thay thế toạ độ block "làm tâm" cũng không khó.
Việc định danh tên block theo giá trị thuộc tính để đo khoảng cách cũng không khó.
Chỉ khó là người nhờ viết lisp lại ra đầu bài không rõ ràng làm người viết lisp phải khốn khổ. Đưa bản vẽ này làm mẫu, lại dùng bản vẽ khác, mà bản vẽ khác cũng sai về toạ độ điểm chèn block mới khốn khổ.
Đầu tư viết 1 lisp như thế này rất vất vả, lấy được 4 field từ 2 đối tượng tính căn bậc hai của tổng 2 bình phương của hiệu từng cặp 4 field này không đơn giản chút nào, bây giờ thì không cần dùng nữa, đôi khi cảm thấy nản.
-
2 giờ trước, lethanh2004 đã nói:Dạ trước tiên cháu cảm ơn chú Thiệp đã quan tâm giúp cháu trong vấn đề này ….
Chú có thể cho cháu hỏi là
1. Cháu test ở bản vẽ đầu thì khoảng cách chạy ra thấy chưa đúng với BV
2. Cháu test bản vẽ khác thì lisp lại không chọn được đối tượng ( cháu gửi bv bên dưới)
3. Chú Có thể sửa giúp cháu thành (thay thế block màu đỏ thành file txt để chạy ra file mẫu như bên layout không ) cháu cảm ơn chú ạ.
1. Bản vẽ đầu là bản vẽ nào? có phải bản vẽ đưa lên cadviet làm mẫu không? Đối với bản vẽ này, lisp chạy rất tốt, khoảng cách tìm được với nhiều kiểu số lẻ sau số thập phân mà.
2. Bản vẽ khác có giống bản vẽ tes.dwg không? Đối với bản vẽ này, có nhiều vấn đề:
* Các block cần làm tâm (DC) và block cần đo khoảng cách (GHICHU) có các điểm chèn (X,Y,Z) bị nhảy rất xa so với "tâm" block, Z cao độ của các block có cái bị nằm dưới mực nước biển! vì vậy việc đo khoảng cách sẽ không bao giờ chính xác.
* Tên của block cũng đã bị thay đổi so với bản vẽ mẫu up lên để viết lisp.
* Tính chất thuộc tính của các block cũng khác xa với bản vẽ mẫu up lên để viết lisp:
- Block cần làm tâm đo: ở bản vẽ mẫu: lấy tên các thuộc tính làm tên block cần làm tâm (thuộc tính "1" =1, 2, 3 ,4 và thuộc tính "A"=A). Đối với bản vẽ tes.dwg các thuộc tính lại là tên mốc và giá trị cao độ mốc, hai cái khác nhau.
- Block cần đo: bản vẽ mẫu tên block là B, C còn bản vẽ tes.dwg thì chỉ có 1 tên duy nhất là GHICHU, nhưng thuộc tính thì có thay đổi.
Nói chung là bản vẽ up làm mẫu và bản vẽ tes.dwg khác nhau hoàn toàn.
3. (thay thế block màu đỏ thành file txt để chạy ra file mẫu như bên layout không ): việc lấy dữ liệu bên ngoài thay thế cho việc tìm toạ độ điểm chèn các block cần làm tâm đo: Tại sao không nói trước luôn để khỏi chỉnh sửa lisp?
Lisp chỉ đưa ra bảng table. sau đó người dùng đánhlệnh TABLEEXPORT để xuất dữ liệu table ra file *.csv; Copy các số liệu trong file *.csv vào bản vẽ khác hoặc vào layout khác.
-
Lisp đo khoảng cách từ điểm insert block A đến các điểm insert block B, C; đưa các số đo khoảng cách vào trong 1 Table, có tạo field các khoảng cách này vào cột distance. Sau khi chạy lisp xong, nếu người dùng move các block A, B, C, thì giá trị khoảng cách sẽ thay đổi theo, sau khi đánh lệnh redraw.
Nên nhớ: để tìm các block B, C từ block A, lisp yêu cầu người dùng nhập "bán kính ảnh hưởng", nghĩa là từ tâm là điểm insert block A, lisp sẽ tạo 1 đường gần như tròn, trong "đường tròn" này phải có các block B và C nằm trong. Người dùng lisp phải chọn "bán kính ảnh hưởng" sao cho phù hợp để từ block A nó tìm ra được các block B, C gần nó nhất.
Kỳ công của lisp này là tạo field khoảng cách 2 điểm insertpoint của block đưa vào cell của table đó.
;; Lisp "Statistics table: Add field Distance of insertionPoints of blocks" ;;; by : Trân Thiêp ;;; tel : 0918841230 ;;; date: 04/2020 (defun DXF (code en) (cdr (assoc code (entget en)))) (defun po-20p (p R / lp n) (setq n 1) (repeat 20 (setq lp (cons (polar p (* pi 0.1 n) R) lp)) (setq n (1+ n))) lp ) (defun c:dkcb (/ ssA ApCad actDoc *Model* *TextStyles* FontFile prec col row l1 l2 pTab1 pTab2 objTable n ssB-C ent-L_A ent-L_BC tag_lst dX dX* dY dX* str obj1 obj2 ID1 ID2 dis Rad len ) (command "undo" "be") (setq ApCad (vlax-get-acad-object) actDoc (vla-get-ActiveDocument ApCad) *Model* (vla-get-ModelSpace actDoc) *TextStyles* (vla-get-TextStyles actDoc) ) (setq FontFile "C:\\Windows\\Fonts\\Times.ttf") (if (not (tblobjname "STYLE" "TNR")) (progn (setq tsobj (vla-add *TextStyles* "TNR")) (vla-put-FontFile tsobj FontFile) ) ) (defun *error* (msg) (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" 0)) (setq A2k (atof (substr (getvar 'acadver) 1 4))) ; (Setq col 3 row 3 L1 nil ) (setq W 15) (setq pTab1 (getvar "Extmin")) (setq pTab1 (list (- (car pTab1) (* W col)) (- (cadr pTab1) (* W row)) 0.0)) (if (> A2k 16) (progn (setq objTable (vla-AddTable *Model* (vlax-3D-point pTab1) row col 5 W ) ) (vla-SetTextHeight objTable acTitleRow 2.0) (vla-SetTextStyle objTable (+ acHeaderRow acTitleRow) "TNR") (vla-SetRowHeight objTable 0 10) (vla-setText objTable 0 0 "Statistics table: Distance of insertionPoints of blocks" ) (vla-setText objTable 1 0 "Blocknames") (vla-setText objTable 1 2 "Distance (m)") (vla-MergeCells objTable 1 1 0 1) (vla-MergeCells objTable 1 2 2 2) (vla-setText objTable 2 0 "from") (vla-setText objTable 2 1 "to") (setq n 3) (setq ssA (ssget '((0 . "INSERT") (2 . "A")))) (if (null (setq prec (getint (acet-str-format "\nEnter number of decimal places: <%1> " (itoa (getvar "useri1")) ) ) ) ) (setq prec (getvar "useri1")) ) (setvar "useri1" prec) (or (/= (getvar "userr1") 0.0) (setvar "userr1" 14)) (if (null (setq Rad (getreal (acet-str-format "\nEnter Influence radius: <%1> " (rtos (getvar "userr1") 2 prec) ) ) ) ) (setq Rad (getvar "userr1")) ) (setvar "userr1" Rad) (if ssA (progn (setq ent-L_A (acet-ss-to-list ssA)) (mapcar '(lambda (e) (setq tag_lst (acet-insert-attrib-get e)) (setq L1 (append L1 (list (list (strcat (cadar tag_lst) (cadadr tag_lst) ) e ) ) ) ) ) ent-L_A ) (setq L1 (vl-sort L1 '(lambda (e1 e2) (< (car e1) (car e2)))) ) (foreach lst L1 (setq name1 (car lst) entA (cadr lst) ) (setq obj1 (vlax-ename->vla-object entA) ID1 (vla-get-objectid obj1) ) (setq lstpo (po-20p (dxf 10 entA) Rad)) (setq ssB-C (ssget "CP" lstpo '((0 . "INSERT") (2 . "B,C")) ) ) (setq L2 nil) (if ssB-C (progn (setq ent-L_BC (acet-ss-to-list ssB-C)) (setq len (length ent-L_BC)) (vla-InsertRows objTable row 5 len) (setq row (+ row len)) (mapcar '(lambda (e) (setq L2 (append L2 (list (list (dxf 2 e) e)) ) ) ) ent-L_BC ) (setq L2 (vl-sort L2 '(lambda (e1 e2) (< (car e1) (car e2)) ) ) ) (foreach lst L2 (setq name2 (car lst) entBC (cadr lst) ) (setq name2 (dxf 2 entBC)) (setq obj2 (vlax-ename->vla-object entBC) ID2 (vla-get-objectid obj2) ) (setq dX (strcat (acet-str-format "(%<\\AcObjProp Object(%<\\_ObjId %1>%).InsertionPoint \\f \"%lu2%pt1%pr%2\">%-" (itoa ID2) (itoa prec) ) (acet-str-format "%<\\AcObjProp Object(%<\\_ObjId %1>%).InsertionPoint \\f \"%lu2%pt1%pr%2\">%)" (itoa ID1) (itoa prec) ) ) ) (setq dY (strcat (acet-str-format "(%<\\AcObjProp Object(%<\\_ObjId %1>%).InsertionPoint \\f \"%lu2%pt2%pr%2\">%-" (itoa ID2) (itoa prec) ) (acet-str-format "%<\\AcObjProp Object(%<\\_ObjId %1>%).InsertionPoint \\f \"%lu2%pt2%pr%2\">%)" (itoa ID1) (itoa prec) ) ) ) (setq dX* (strcat dX "*" dX) dY* (strcat dY "*" dY) ) (setq dis (strcat "sqrt" "(" dX* "+" dY* ")") ) (setq str (acet-str-format "%<\\AcExpr (%1) \\f \"%lu2%pr%2\">%" dis (itoa prec) ) ) (vla-setText objTable n 0 name1) (vla-setText objTable n 1 name2) (vla-setText objTable n 2 str) (setq n (+ n 1)) ) ) ) ) ) ) (vla-SetTextStyle objTable acDataRow "TNR") (setq rowtypes (list acHeaderRow acTitleRow acDataRow)) (mapcar '(lambda (x) (vla-SetAlignment objTable x acMiddleCenter)) rowtypes ) (vla-SetTextHeight objTable (+ acHeaderRow acDataRow) 1.8) (setq pTab2 (acet-ss-drag-move (ssadd (vlax-vla-object->ename objTable)) pTab1 "\n<<< Pick a point for set place of Table >>> " ) ) (vla-move objTable (vlax-3d-point pTab1) (vlax-3d-point pTab2)) (vlax-release-object objtable) ) (acet-ui-message "This autoCad version doesn't support addTable" "Warning" 4144 ) ) ;_if (acet-sysvar-restore) (command "undo" "en") (princ "\nOK") (princ) )
-
1
-
-
4 giờ trước, lethanh2004 đã nói:Em xin phép ace trong diễn đàn cho em hỏi ngu 1 chút . Em được biết block att có thể insert field … tọa độ vào đó . vậy cho em hỏi nó có thể tự động ghi khoảng cách giữa 2 block Att với nhau không ? nếu có thì cách làm như thế nào ! mong ace chỉ dẫn giúp . ví dụ như hình dưới
- Mỗi block có 1 toạ độ insert, nên có thể tạo field toạ độ insert vào trong các thuộc tính được. Ở đây khoảng cách giữa 1 block với N block khác thì biết bao nhiêu ATT trong block màu đỏ? có khi 2 có khi 100 block thì làm sao?
- Muốn tìm các block B, C gần block màu đỏ (mốc 1A), người ta tạo 1 "fenc" đường bao (màu vàng nét đứt) ví dụ có phạm vi R=10 thì sẽ tìm ra, từ đó tính khoảng cách giữa block màu đỏ đến các block B, C. Tuy nhiên có trường hợp nó chồng chất nhau như ở trung tâm hình dưới đây thì sao?
- Nếu tìm được thì ghi các khoảng cách này thành 1 bảng có giá trị text hat att được gắn field ??
-
2
-
-
2 giờ trước, thanhduan2407 đã nói:Không biết bảng toạ độ bác là Table hay các line rời rạc ạ? Nếu là Table thì bác cho em xin đoạn lisp tạo table được không ạ? Em muốn tham khảo 1 vài nguồn để học tập.
Nếu bác cho phép thì bác gửi vào Email của em là: heaven2407@gmail.com
Em cảm ơn bác nhiều.
Đối tượng Table đó Thanhduan. Ok anh sẽ gửi cho đoạn mã lisp tạo table, bao gồm:
- Set text vào cell
- Set chiều cao row
- Set chiều rộng colomn
- Set màu đường lưới
- Merge các cell
-
1
-
-
Lisp này giúp cho những ai làm công tác đo đạc giải thửa, quy hoạch đất đai, tư vấn thăm dò khoáng sản...
-
3
-
1
-
viết giùm em lisp vẽ đường chéo của hình vuông hoặc hình chữ nhật
trong AutoLisp
Đã đăng · Trả lời báo cáo
2 ly cafe để vừa nhấn nháp vừa viết lisp được không bạn? ok thì cho địa chỉ email nghen @PhamYen
LL: email: tranthiep66@gmail.com