Chuyển đến nội dung
Diễn đàn CADViet
VO HINH

Lisp thông kê danh mục bản vẽ

Các bài được khuyến nghị

Mình có sưu tầm dc lisp thông kê ATT block,  hiện tại phần STT đang hiển thị tên Block  xin nhờ các cao nhân sửa giúp phần STT theo thứ tự 1-2-3-....

image.png.d6d3a8403d1717fa588f6e32957c4221.png

và chỉnh sửa lại lisp khi quét chuột tạo bảng thổng kế sắp xếp tên và ký hiệu theo thứ tự

lisp :

(Defun c:DM (/ at>att at>item at>set atable cnt cw ena nc nr pt 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 MUC BAN VE")
    (vla-setcellvalue aTable 1 0 "STT")
    (vla-setcellvalue aTable 1 1 "TEN BAN VE") 
    (vla-setcellvalue aTable 1 2 "KY HIEU")
    (vla-MergeCells aTable 1 1 2 (length (cadar at>att)))
    (setq CNT 2) ;_ end_setq
    (foreach Item at>att
    (vla-setcellvalue aTable CNT 0 (car Item))
    (setq at>item 1)
    (while (<= at>item (length (cadar at>att)))
        (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
         ) ;_ 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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
2 giờ trước, VO HINH đã nói:

Thank DungNguyen 685, em đã thay đổi nhưng vẫn k dc.

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 đó.

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

DungNguyen685  có thểm thêm lệnh để lisp hoàn chỉnh đc k?

 tạo bảng thổng kế sắp xếp tên và ký hiệu theo thứ tự  kt 01- kt 02.....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
17 giờ trước, VO HINH đã nói:

DungNguyen685  có thểm thêm lệnh để lisp hoàn chỉnh đc k?

 tạo bảng thổng kế sắp xếp tên và ký hiệu theo thứ tự  kt 01- kt 02.....

(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.

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
1 giờ} trướ}c, DungNguyen685 đã nói:

(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 hay vni... để không bị lỗi font.

Thank DungNguyen685  nhiều.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
4 phút trước, kysuketcau đã nói:

Tôi sử dụng lisp của bạn. Nhưng sử dụng chỉ tạo ra khung trống. Không thể thống kê được. Nhờ bạn chỉ giúp

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

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Quote

DungNguyen685  có thểm thêm lệnh để lisp hoàn chỉnh đc k?

 tạo bảng thổng kế sắp xếp tên và ký hiệu theo thứ tự  kt 01- kt 02.....

 

test trên file :

Vào lúc 25/7/2021 tại 18:54, VO HINH đã nói:

đây bạn.

test.dwg

 

vvvvvv.gif

  • Like 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
  •  
Quote

Đây bạn ơi. tôi làm thôi của bạn cũng không được. 1 do lỗi phông. 2 là khi đưa ra thì chỉ có bảng trống. Mục tên bản vẽ: Tôi dùng MTEXT ko Block. Và số bản vẽ cũng vậy

5 giờ trước, DungNguyen685 đã nói:

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

 

test trên file :

 

vvvvvv.gif

 

 

 

khung bản vẽ.dwg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lúc acad hỏi select objects, bạn nhấn f rồi enter (để kích hoạt chức năng fence khi select), sau đó click các điểm để tạo thành một pline giao với các bản vẽ.

Thứ tự attrubute được thống kê sẽ theo thứ tự tự các điểm em mà bạn vừa click

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
4 giờ trước, Bình111002 đã nói:

Em sử dụng được lisp, nhưng Tên bản vẽ và Kí hiệu đảo ngược cho nhau . Bác nào giúp em với.

image.png.0dc0180e7f115f1fa90a0c5289137558.png

Cái này bạn đảo vị trí 2 tag bản vẽ và ký hiệu xem có được không??

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vào lúc 25/1/2022 tại 10:34, Bình111002 đã nói:

Em sử dụng được lisp, nhưng Tên bản vẽ và Kí hiệu đảo ngược cho nhau . Bác nào giúp em với.

image.png.0dc0180e7f115f1fa90a0c5289137558.png

Bạn dùng lệnh BATTMAN, rồi re-order các attribute sao cho tên bản vẽ lên trước ký hiệu, sau đó nhấn vào nút SYNC.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Mình thường vẽ trong layout, mỗi layout một bản vẽ. Như thế có dùng lips thống kê này được không  các bạn. Làm thế nào để dùng được cho bản vẽ từng layout.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vào lúc 16/2/2022 tại 10:25, NGUỴEN V THANG đã nói:

Mình thường vẽ trong layout, mỗi layout một bản vẽ. Như thế có dùng lips thống kê này được không  các bạn. Làm thế nào để dùng được cho bản vẽ từng layout.

Bạn thử dùng là biết có được hay không ngay.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Vào lúc 28/7/2021 tại 07:44, DungNguyen685 đã nói:

Bạn phải tạo khung như này mới được.

Tao Danh Muc.lsp

khung bản vẽ.dwg

Bạn xem giúp mình vì sao  khung tên mình phá block ra sau đó tạo lại thì không tạo được danh mục với!

tests.dwg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

×