DungNguyen685

Mình hay làm là như này: Bước 1: tạo 1 data mẫu hình dạng thép bằng block att(mình từng làm đc 60 hình dạng rồi) Bước 2: Viết lisp khi dùng để field giá trị rồi gán bằng Xdata các giá trị cần thiết. Bước 3: Tạo bảng thông kê bằng cách insert data của bước 1 gán các giá trị cần thiết. (lisp "như" này mình đã từng viết rồi vì không up video lớn lên đc muốn tham khảo có thể ib mình để xem video)

Bạn phải tạo khung như này mới được. Tao Danh Muc.lsp khung bản vẽ.dwg

Mình chỉnh sửa theo yêu cầu này: test trên file :

Bạn gửi bản vẽ đó lên đây đi mình hd cho.

À, Dịch bệnh có tgian nên sửa giúp bạn ấy cũng để học hỏi thêm thôi chứ không có ý đó. lisp trên mình sửa hộ nhưng bạn ấy không dùng được rồi. Cái này mình cũng sửa lại từ lisp trên, nếu thật sự cần để làm việc thì có thể ib mình để teamview xem giúp thử lỗi gì (không phí :d)

Cái này thì không khó, bạn có thể liên hệ bác @Doan Nguyen Van cho nhanh.

text hay mtext đều được mà. cad 2018 với 2010 không thấy lỗi.

Chú ý tên block mới không trùng với các block cũ trong bản vẽ. (defun c:cre (/ err oer res sta bb entzx sttt made) (defun err(s) (if (and (/= s "Function cancelled")(/= s "quit / exit abort")) (princ (strcat "\n>>Error: " s)) ) (res) ) (defun res() (if cla (setvar "Clayer" cla)) (setq *error* oer) (setvar "Cmdecho" 1) (princ) ) (defun sta() (setq oer *error* *error* err cla (getvar "Clayer") ) (setvar "Cmdecho" 0) (setvar "Clayer" "0") (graphscr) ) (defun made(/ loop ss p) (setq loop T) (while loop (princ "\nChon doi tuong tao block: ") (setq p1 (getpoint "\nPick point1 window: ") p2 (getcorner p1 "\nPick point2 corner: ") ) (setq ss (ssget "_C" p1 p2 )) (if (null ss)(exit)) (setq sttt 0) (while (< sttt (sslength ss)) (setq entzx (ssname ss sttt)) (setq bb (cdr (assoc 0 (entget entzx)))) (if (= bb "INSERT") (command "EXPLODE" entzx ) ) (setq sttt (1+ sttt)) ) (setq sss (ssget "_C" p1 p2 )) (princ "\nChon text lam name block: ") (setq ssText (ssget ":S:E" '((0 . "MTEXT,TEXT")))) (if (null ssText)(exit)) (setq p (getpoint "\nChon diem dat block: ")) (if (null p)(exit)) (command "_.Undo" "_Group") (command "_.Cutclip" sss "") (command "_.Pasteblock" p) (setq ent (entlast)) (setq dxf1 (cdr(assoc 1 (entget (ssname ssText 0) )))) (setq dxf2 (cdr(assoc 2 (entget ent )))) (command "-RENAME" "B" dxf2 dxf1 ) (command "_.Undo" "_End") ) ) (sta) (made) (res) (princ) )

(defun c:DM (/ at>att at>item at>set atable cnt cw ena nc nr pt j list1 list2 list3 L rh) (vl-load-com) ;; GET_ATTS BY BILL KRAMER (defun get_ATTS (EN / EL ATTS) (setq EL (entget EN)) (setq ENA (cdr (assoc 2 EL))) ; wiz (if (and (= (cdr (assoc 0 EL)) "INSERT") (= (cdr (assoc 66 EL)) 1) ) ;_ end and (progn (setq EN (entnext EN) EL (entget EN) ) ;_ end setq (while (= (cdr (assoc 0 EL)) "ATTRIB") (setq ATTS (cons (list (vla-get-ObjectID (vlax-ename->vla-object EN) ) ; wiz (cdr (assoc 2 EL) ) ;_ end_cdr (cdr (assoc 1 EL)) ) ;_ end_list ATTS ) ;_ end_cons EN (entnext EN) EL (entget EN) ) ;_ end setq ) ;_ end while (list ena (reverse ATTS)) ; wiz ) ;_ end progn ) ;_ end if ) ;_ end_defun (if (setq at>set (ssget '((0 . "INSERT")))) (progn (setq at>att (mapcar 'get_atts (vl-remove-if 'listp (mapcar 'cadr (ssnamex at>set)) ) ;_ end_vl-remove-if ) ;_ end_mapcar ) ;_ end_setq (setq PT (getpoint "\nTable insertion point: ") RH (* 2.0 (getvar "TEXTSIZE")) CW (* 20.0 (getvar "TEXTSIZE")) NR (+ 2 (length at>att)) NC (1+ (length (cadar at>att))) ) ;_ end_setq (setq aTable (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object) ) ;_ end_vla-get-activedocument ) ;_ end_vla-get-modelspace (vlax-3d-point PT) NR NC RH CW ) ;_ end_vla-addtable ) ;_ end_setq (vla-setcellvalue aTable 0 0 "DANH M\U+1EE4C B\U+1EA2N V\U+1EBC") (vla-setcellvalue aTable 1 0 "STT") (vla-setcellvalue aTable 1 1 "T\U+00CAN B\U+1EA2N V\U+1EBC") (vla-setcellvalue aTable 1 2 "K\U+00DD HI\U+1EC6U") (vla-MergeCells aTable 1 1 2 (length (cadar at>att))) ;(princ (cadr at>att)) ;;edit by tavantants (setq L nil ) (setq j 0) (while (< j (length at>att) ) (setq list1 (nth j at>att)) (setq list2 (nth 2 (cadr (nth 1 list1)))) (setq list3 (substr list2 (+ 2 (vl-string-search " " list2)))) (setq L (append L (list (list list3 (nth 1 list1) )))) (setq j (1+ j)) ) (setq L (vl-sort L '(lambda (x y) (< (atof(car x)) (atof(car y)))))) ;;edit by tavantants (setq CNT 2) ;_ end_setq (foreach Item L (vla-setcellvalue aTable CNT 0 (- CNT 1)) ;Thay (car Item) thành (- CNT 1) (setq at>item 1) (while (<= at>item (length (cadar L))) (vl-catch-all-apply '(lambda () (vla-settext aTable CNT at>item (strcat " " "%<\\AcObjProp Object(%<\\_ObjId " (itoa (car (nth (1- at>item) (cadr Item)))) ">%).TextString>%" ) ;_ end_strcat ) ;_ end_vla-setcellvalue ;;edit by tavantants (vla-SetCellAlignment aTable CNT 0 5) (vla-SetCellAlignment aTable CNT 1 4) (vla-SetCellAlignment aTable CNT 2 5) (vla-setTextHeight aTable (- CNT 0) (getvar "TEXTSIZE")) (vla-SetColumnWidth aTable 0 (* 6 (getvar "TEXTSIZE")) ) ;(getvar "TEXTSIZE") (vla-SetColumnWidth aTable 1 (* 24 (getvar "TEXTSIZE"))) (vla-SetColumnWidth aTable 2 (* 14 (getvar "TEXTSIZE"))) (vla-SetRowHeight aTable 0 (* 2 (getvar "TEXTSIZE"))) (vla-SetRowHeight aTable 1 (* 2 (getvar "TEXTSIZE"))) (vla-SetRowHeight aTable 2 (* 2 (getvar "TEXTSIZE"))) (vla-SetRowHeight aTable (- CNT 0) (* 2 (getvar "TEXTSIZE"))) ;;edit by tavantants ) ;_ end_lambda ) ;_ end_vl-catch-all-apply (setq at>item (1+ at>item)) ) ;_ end_while (setq CNT (1+ CNT)) ;;ready next row ) ;_ end_foreach ) ;_ end_progn ) ;_ end_if (princ) ) ;_ end_Defun Bạn thử cái này. Chú ý ký hiệu bản vẽ giữa chữ với số là dấu cách. VD: KT 01 hoặc KT 1 Còn nếu muốn thay đổi bằng ý tự "-" hay gì đó thì sửa trong 2 dấu " " chỗ này. (setq list3 (substr list2 (+ 2 (vl-string-search " " list2)))) Mình có edit thêm một số chỗ giãn dòng và cột phụ thuộc vào TEXTSIZE, nên để textstyle Standard font họ arial... để không bị lỗi font.

Bạn xem lại thử sửa đúng mình nói và load lại chưa. Chứ sửa thế đúng rồi đó.

thay (vla-setcellvalue aTable CNT 0 (car Item)) thành (vla-setcellvalue aTable CNT 0 (- CNT 1))

Liên hệ bác @Doan Nguyen Van mời ly cafe đi. Chứ lúc nào cũng trông mong vào free thì biết đến bao giờ có để mà làm việc.

Vì mấy anh chia sẻ rồi em cũng thử bằng cách nêu lúc đầu. Chứ không có ý làm ảnh hưởng đến bác @Doan Nguyen Van nhé! (defun getVert (e / i L) ;;;Return list of all vertex from pline e (setq i 0 L nil) (vl-load-com) (repeat (fix (+ (vlax-curve-getEndParam e) 1)) (setq L (append L (list (vlax-curve-getPointAtParam e i)))) (setq i (1+ i)) ) L ) (defun c:STR(/ ent p1 cmd osm L diem1 diem2 diem3 diem4 diem5 diem6 diem7 kc1 kc2 L1 L2 L3 gt1 gt2 gt3 list1 list2 doan1 doan2 doan3 doan4 doan5 doan6 doan7 doan8 sset k lay1 lay2 lay3 lay4 lay5 lay6 ssetz ) (prompt "Chon doi tuong muon STRETCH") (setq ent (car (entsel))) (setq p1 (getpoint "\nChon diem muon STRETCH den:")) (command ".undo" "BE") (setq cmd (getvar "CMDECHO")) (setq osm (getvar "OSMODE")) (setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setq L (getvert ent)) (setq L (vl-sort L '(lambda (x y) (> (cadr x)(cadr y))))) (setq diem1 (car (nth 0 L))) (setq diem2 (car (nth 1 L))) (setq diem3 (cadr (nth 0 L))) (setq diem4 (cadr (nth 1 L))) (setq diem5 (car p1) ) (setq diem6 (list diem5 diem3 )) (setq diem7 (list diem5 diem4 )) (setq kc1 (distance (nth 0 L) diem6)) (setq kc2 (distance (nth 1 L) diem7)) (setq L1 nil ) (setq L2 nil ) (setq L3 nil ) (setq j 0) (if (< diem1 diem2) (progn ;(alert "loaij1") (if (< kc1 kc2) (progn ;(alert "trai") (while (< j (length L) ) (setq gt1 (/ (atof (itoa j)) 2)) (setq gt2 (fix gt1)) (setq gt3 (- gt1 gt2)) (if (= gt3 0) (progn (setq list1 (nth j L)) (setq L1 (append L1 (list list1))) ) (progn (setq list2 (nth j L)) (setq L2 (append L2 (list list2))) ) ) (setq j (1+ j)) ) ) ) (if (> kc1 kc2) (progn ;(alert "phai") (while (< j (length L) ) (setq gt1 (/ (atof (itoa j)) 2)) (setq gt2 (fix gt1)) (setq gt3 (- gt1 gt2)) (if (/= gt3 0) (progn (setq list1 (nth j L)) (setq L1 (append L1 (list list1))) ) (progn (setq list2 (nth j L)) (setq L2 (append L2 (list list2))) ) ) (setq j (1+ j)) ) ) ) ) (progn ;(alert "loaij2") (if (< kc1 kc2) (progn ;(alert "phai") (while (< j (length L) ) (setq gt1 (/ (atof (itoa j)) 2)) (setq gt2 (fix gt1)) (setq gt3 (- gt1 gt2)) (if (= gt3 0) (progn (setq list1 (nth j L)) (setq L1 (append L1 (list list1))) ) (progn (setq list2 (nth j L)) (setq L2 (append L2 (list list2))) ) ) (setq j (1+ j)) ) ) ) (if (> kc1 kc2) (progn ;(alert "trai") (while (< j (length L) ) (setq gt1 (/ (atof (itoa j)) 2)) (setq gt2 (fix gt1)) (setq gt3 (- gt1 gt2)) (if (/= gt3 0) (progn (setq list1 (nth j L)) (setq L1 (append L1 (list list1))) ) (progn (setq list2 (nth j L)) (setq L2 (append L2 (list list2))) ) ) (setq j (1+ j)) ) ) ) ) ) (setq k 0) (while (< k (length L1) ) (setq doan1 (nth k L1)) (setq doan6 (car p1) ) (setq doan7 (cadr (nth k L1))) (setq doan8 (list doan6 doan7 0.0) ) (setq doan2 (polar doan1 0 1)) (setq doan3 (polar doan1 0 -1)) (setq doan4 (polar doan2 (/ pi 2) 1)) (setq doan5 (polar doan3 (/ pi 2) -1)) (setq sset (ssget "_C" doan5 doan4 '((0 . "*POLYLINE")))) (setq kc2 (distance doan1 doan8)) (command "stretch" sset "" doan1 doan8) (setq k (1+ k)) ) ;(setq lay1 (nth 0 L1)) ;(setq lay2 (nth (- (length L1) 1) L1)) ;(setq lay3 (polar lay1 (/ pi 2) 10)) ;(setq lay4 (polar lay2 (/ pi 2) -10)) ;(setq lay5 (polar lay3 0 10)) ;(setq lay6 (polar lay4 0 -10)) ;(setq ssetz (ssget "_C" lay5 lay6 '((0 . "*POLYLINE")))) ;(command "stretch" ssetz "" lay1 pause) (setvar "CMDECHO" cmd) (setvar "OSMODE" osm) (command ".undo" "E") (princ) )