[Nhờ giúp đỡ] Lisp đếm block BLKQTY

Tháng 3 21, 2013

Nhờ mọi người chỉnh sửa giúp lisp đếm block này với ạ.

Hiện tại mình có down ở diễn đàn Cadviet được lisp đếm block nhưng với lisp này mình chỉ đếm được các block có tên không dấu(tên tiếng anh). Khi mình dùng lisp này để đếm các block có dấu thì có hiện ra bảng đếm nhưng không có nội dung đếm.

Mong mọi người giúp mình sửa lại lisp này với.Thanks all!

http://www.cadviet.com/upfiles/3/102517_blkqty4.lsp

Similar topics from web:
AutoLisp

Chỉnh sửa Tháng 3 21, 2013 theo pinggun

Tháng 3 21, 2013

Bạn down đc ở đâu sao k post bài hỏi ở đó. lisp mình k đọc n nghe tên thì có vẻ là của bác gia_bach, có lẽ tên đc lấy bằng VL nên khi gặp tên unicode thì có vấn đề chút (ket chua dọc code, đoán vaạy th). sao bạn k post cả cái file đã làm gặp lỗi nữa ?

Tháng 3 22, 2013

Bạn down đc ở đâu sao k post bài hỏi ở đó. lisp mình k đọc n nghe tên thì có vẻ là của bác gia_bach, có lẽ tên đc lấy bằng VL nên khi gặp tên unicode thì có vấn đề chút (ket chua dọc code, đoán vaạy th). sao bạn k post cả cái file đã làm gặp lỗi nữa ?

Chính xác. (do VL không hỗ trợ tốt Unicode)

@pinggun :

tìm dòng : (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))

và thay thế bằng : (setq blk_name (cdr (assoc 2 (entget ent))))

Tháng 4 2, 2013

Em đã đếm được rồi.Cám ơn bác ketxu và bác gia_bach nhiều nha.

Tháng 4 5, 2015

Chính xác. (do VL không hỗ trợ tốt Unicode)

@pinggun :

tìm dòng : (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))

và thay thế bằng : (setq blk_name (cdr (assoc 2 (entget ent))))

Lisp rất tuyệt vời, tìm mãi mới được cái lisp đúng với nhu cầu công việc

Xin lỗi gia_bach, nhờ gia_bach bớt chút thời gian sửa giúp mình font có dấu được không? (font vni-helve nhé)

Cảm ơn gia_bach nhiều

Tháng 4 6, 2015

Lisp rất tuyệt vời, tìm mãi mới được cái lisp đúng với nhu cầu công việc

Xin lỗi gia_bach, nhờ gia_bach bớt chút thời gian sửa giúp mình font có dấu được không? (font vni-helve nhé)

Cảm ơn gia_bach nhiều

Yêu cầu khá là "mơ hồ", vui lòng gửi file Cad minh hoạ.

Gửi lại List Fix lỗi tên block tiếng Việt :

(defun c:BlkQty (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
(defun TxtWidth (val h msp / txt minp maxp)
  (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
  (foreach itm (vlax-for itm objTblStyDic
		 (setq tabLst (append tabLst (list itm))))
    (if (not
	  (vl-catch-all-error-p
	    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name)))  )  )
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
	TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
	      (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )
  
(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method
      (vla-get-Utility *adoc)
      'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))  
;main
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (vl-load-com)
      (setq i -1 len0 8)
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
	(if (> (setq blk_len (strlen blk_name)) len0)
	  (setq str blk_name len0 blk_len) )	
	(if (not (assoc blk_name lst_blk))
	  (setq lst_blk (cons (cons blk_name 1) lst_blk))
	  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
			       (assoc blk_name lst_blk) lst_blk)))	    )
      (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
      (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
      (initget "Yes No")
      (setq ins (getkword "\nChen ki hieu Block [Yes/No ] <yes> : ") )
      (or ins (setq ins "Yes"))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)      
      (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
      (initget 6)
      (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))      
      (if h (setq *h* h) (setq h *h*) )
      (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	    msp (vla-get-modelspace *adoc)
	    blks (vla-get-blocks *adoc))      
      (setq width1 (* 2 (TxtWidth "STT" h msp))
	    width (* 2 (TxtWidth "So luong" h msp))
	    height (* 2 h))
      (if str
	(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
	(setq width2 width))
      (if (> h 3)
	(setq width (* (fix (/ width 10))10)
	      width1 (* (fix (/ width1 10))10)
	      width2 (* (fix (/ width2 10))10)
	      height (* (fix (/ height 5))5)))
      (GetOrCreateTableStyle "CadViet")
      (setq pt (getpoint "\nDiem dat Bang :")
	    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
      (vla-put-regeneratetablesuppressed TblObj :vlax-true)
      (vla-SetColumnWidth TblObj 0 width1)
      (vla-SetColumnWidth TblObj 1 width2)
      (vla-put-vertcellmargin TblObj (* 0.75 h))
      (vla-put-horzcellmargin TblObj (* 0.75 h))
      (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
	      (list acTitleRow acHeaderRow acDataRow) )
      (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
	      (list acTitleRow acHeaderRow acDataRow))      
      (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
      (vla-setText TblObj 0 0 "Bang thong ke")
      (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) 
      (repeat (length header_lsp)
	(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
      (setq row 2 i 1)    
      (foreach pt lst_blk
	(setq blk_name (car pt) j -1 )
	(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
		(list i blk_name "cai" (cdr pt)))
	(if (= ins "Yes")
	  (vlax-for blk blks
	    (if (= (vla-get-Name blk) blk_name)
	      (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID blk) :vlax-true))) )
	(vla-SetCellAlignment TblObj row 1 7)
	(vla-SetCellAlignment TblObj row 3 9)
	(setq row (1+ row) i (1+ i))	)
      (vla-put-regeneratetablesuppressed TblObj :vlax-false)
      (vlax-release-object TblObj) )  )
  (princ))

Tháng 4 6, 2015

Yêu cầu khá là "mơ hồ", vui lòng gửi file Cad minh hoạ.

Gửi lại List Fix lỗi tên block tiếng Việt :

(defun c:BlkQty (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i
		 ins j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y)
;;  By : Gia Bach, gia_bach @  www.CadViet.com             ;;
(defun TxtWidth (val h msp / txt minp maxp)
  (setq	txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) h))
  (vla-getBoundingBox txt 'minp 'maxp )
  (vla-Erase txt)
  (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )

(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
  (setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE") )  
  (foreach itm (vlax-for itm objTblStyDic
		 (setq tabLst (append tabLst (list itm))))
    (if (not
	  (vl-catch-all-error-p
	    (setq name (vl-catch-all-apply 'vla-get-Name (list itm)))))
      (setq nameLst (append nameLst (list name)))  )  )
  (if (not (vl-position tbl_name nameLst))
    (vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
  (setq objTblSty (vla-item objTblStyDic tbl_name)
	TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
  (mapcar '(lambda (x)(vla-settextstyle objTblSty x TxtSty))
	      (list acTitleRow acHeaderRow acDataRow) )
  (vla-setvariable *adoc "CTableStyle" tbl_name) )
  
(defun GetObjectID (obj)
  (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
    (vlax-invoke-method
      (vla-get-Utility *adoc)
      'GetObjectIdString obj :vlax-false )
    (vla-get-Objectid obj)))  
;main
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (vl-load-com)
      (setq i -1 len0 8)
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))
	(if (> (setq blk_len (strlen blk_name)) len0)
	  (setq str blk_name len0 blk_len) )	
	(if (not (assoc blk_name lst_blk))
	  (setq lst_blk (cons (cons blk_name 1) lst_blk))
	  (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk))))
			       (assoc blk_name lst_blk) lst_blk)))	    )
      (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) ))
      (setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
      (initget "Yes No")
      (setq ins (getkword "\nChen ki hieu Block [Yes/No ] <yes> : ") )
      (or ins (setq ins "Yes"))
      (mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)      
      (or *h* (setq *h* (* (getvar "dimtxt")(getvar "dimscale"))))
      (initget 6)
      (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))      
      (if h (setq *h* h) (setq h *h*) )
      (setq *adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	    msp (vla-get-modelspace *adoc)
	    blks (vla-get-blocks *adoc))      
      (setq width1 (* 2 (TxtWidth "STT" h msp))
	    width (* 2 (TxtWidth "So luong" h msp))
	    height (* 2 h))
      (if str
	(setq width2 (* 1.5 (TxtWidth (strcase str) h msp)))
	(setq width2 width))
      (if (> h 3)
	(setq width (* (fix (/ width 10))10)
	      width1 (* (fix (/ width1 10))10)
	      width2 (* (fix (/ width2 10))10)
	      height (* (fix (/ height 5))5)))
      (GetOrCreateTableStyle "CadViet")
      (setq pt (getpoint "\nDiem dat Bang :")
	    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
      (vla-put-regeneratetablesuppressed TblObj :vlax-true)
      (vla-SetColumnWidth TblObj 0 width1)
      (vla-SetColumnWidth TblObj 1 width2)
      (vla-put-vertcellmargin TblObj (* 0.75 h))
      (vla-put-horzcellmargin TblObj (* 0.75 h))
      (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
	      (list acTitleRow acHeaderRow acDataRow) )
      (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
	      (list acTitleRow acHeaderRow acDataRow))      
      (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 3)) )))
      (vla-setText TblObj 0 0 "Bang thong ke")
      (setq j -1 header_lsp (list "STT" "Ten" "Don vi" "So luong" "Ky hieu")) 
      (repeat (length header_lsp)
	(vla-setText TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
      (setq row 2 i 1)    
      (foreach pt lst_blk
	(setq blk_name (car pt) j -1 )
	(mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x))
		(list i blk_name "cai" (cdr pt)))
	(if (= ins "Yes")
	  (vlax-for blk blks
	    (if (= (vla-get-Name blk) blk_name)
	      (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID blk) :vlax-true))) )
	(vla-SetCellAlignment TblObj row 1 7)
	(vla-SetCellAlignment TblObj row 3 9)
	(setq row (1+ row) i (1+ i))	)
      (vla-put-regeneratetablesuppressed TblObj :vlax-false)
      (vlax-release-object TblObj) )  )
  (princ))

Cảm ơn gia_bach đã quan tâm

Ý mình khi chọm điểm đặt bảng, font trong bảng thống kê là tiếng việt có dấu (style, font là Vni-helve)

Rất mong sự giúp đỡ của gia_bach.

Tháng 4 10, 2015

Nhờ gia__bach vào xem giúp mình với

cảm ơn bạn

Tháng 4 10, 2015

Cảm ơn gia_bach đã quan tâm

Ý mình khi chọm điểm đặt bảng, font trong bảng thống kê là tiếng việt có dấu (style, font là Vni-helve)

Rất mong sự giúp đỡ của gia_bach.

Tên Block trong bản vẽ phải đúng font chữ Tiếng Việt (style, font là Vni-helve) thì bảng mới xuất ra đúng tên Tiếng Việt được bạn HoangSon614 à

Tháng 5 24, 2015

Nhờ mọi người chỉnh sửa giúp lisp đếm block này với ạ.

Hiện tại mình có down ở diễn đàn Cadviet được lisp đếm block nhưng với lisp này mình chỉ đếm được các block có tên không dấu(tên tiếng anh). Khi mình dùng lisp này để đếm các block có dấu thì có hiện ra bảng đếm nhưng không có nội dung đếm.

Mong mọi người giúp mình sửa lại lisp này với.Thanks all!

http://www.cadviet.com/upfiles/3/102517_blkqty4.lsp

Similar topics from web:
AutoLisp

Similar topics from web:
[Nhờ giúp đỡ] Lisp đếm block BLKQTY

AutoLisp

cho mình xin cái lisp đếm block đó đi bạn gmail: tranngoctanxd@gmail.com

thanks bạn nha

Tháng 6 1, 2015

Mình sử dụng bảng thống kê một số block theo lisp BlkQty của bác Gia_bach. Mình có một bảng dữ liệu tên đầy đủ block bên excel. Làm thế nào để lấy tên đầy đủ của block trong excel vào table của block. Hay nói cách khác là thay tên ký hiệu block trong bảng cad bằng tên đầy đủ của block từ bảng dữ liệu tất cả các block từ excel.

Tháng 6 1, 2015

Trong cad cũng có lệnh DATAEXTRACTION kết xuất nhiều loại dữ liệu. Vì nhiều loại nên để thống kê block đến 8 step, Cộng thêm 8 step để đổi tên ký hiệu block thành tên đầy đủ từ excel. Và kết quả là xuất bảng thống kê nhưng không có số thứ tự và hình ký hiệu block như lisp của bác gia_bach. Mình muốn nhờ các pro tìm phương án thống kê nhanh chóng theo cách.

1. Dùng lisp BlkQty của bác Gia_bach để tạo bảng.

2. Đổi tên ký hiệu block thành tên đầy đủ block từ bảng dữ liệu nguồn block từ excel.

Tháng 6 1, 2015

Trong cad cũng có lệnh DATAEXTRACTION kết xuất nhiều loại dữ liệu. Vì nhiều loại nên để thống kê block đến 8 step, Cộng thêm 8 step để đổi tên ký hiệu block thành tên đầy đủ từ excel. Và kết quả là xuất bảng thống kê nhưng không có số thứ tự và hình ký hiệu block như lisp của bác gia_bach. Mình muốn nhờ các pro tìm phương án thống kê nhanh chóng theo cách.

1. Dùng lisp BlkQty của bác Gia_bach để tạo bảng.

2. Đổi tên ký hiệu block thành tên đầy đủ block từ bảng dữ liệu nguồn block từ excel.

Chào bạn!

Như vậy bạn phải cần thêm "phụ tùng" là file excel diễn giải cho việc mô tả tên Block

Sao bạn không dùng chức năng của CAD là gán "miêu tả" đó cho Description của Block

để khi quét dữ liệu trên CAD là ra bảng đó luôn , không cần file Excel vì đã miêu tả thông qua description của Block

Bạn upload File CAD và File Excel của bạn lên đây nhé!

Tháng 6 1, 2015

Đây là file của mình

Mình chỉ làm 1 số block. Nếu thành công thì mình tạo hẳn 1 file dữ liệu đầy đủ các block lưu trong excel để phục vụ cho việc đổi tên blockhttp://www.cadviet.com/upfiles/4/102116_new_folder_3.rar

Tháng 6 1, 2015

Theo tui bác làm như này: Bác lấy Lisp của GIABACH ở trên

1. Tìm dòng: (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))

2. Cho con trỏ ở cuối dòng (Enter) rồi chèn cum này vào:

(cond ((= blk_name "D_D.CT1.1") (setq blk_name "CONG TAC 1 CHIEU 10A"))

((= blk_name "D_FAN1") (setq blk_name "QUAT HUT GAN TUONG 300x300"))

((= blk_name "D_QT1") (setq blk_name "QUAT TRAN SAI CANH 1,4m + DIMMER"))

((= blk_name "TEN BLK") (setq blk_name "TEN DAY DU..."))

)

là ok. Còn bao nhiêu nữa bác tự soạn tương tự trên.

Tháng 6 1, 2015

Theo tui bác làm như này: Bác lấy Lisp của GIABACH ở trên

1. Tìm dòng: (setq blk_name (vla-get-name (vlax-Ename->Vla-Object ent)))

2. Cho con trỏ ở cuối dòng (Enter) rồi chèn cum này vào:

(cond ((= blk_name "D_D.CT1.1") (setq blk_name "CONG TAC 1 CHIEU 10A"))

((= blk_name "D_FAN1") (setq blk_name "QUAT HUT GAN TUONG 300x300"))

((= blk_name "D_QT1") (setq blk_name "QUAT TRAN SAI CANH 1,4m + DIMMER"))

((= blk_name "TEN BLK") (setq blk_name "TEN DAY DU..."))

)

là ok. Còn bao nhiêu nữa bác tự soạn tương tự trên.

Đây:

(cond ((= blk_name "D_D.CT1.1") (setq blk_name "CONG TAC 1 CHIEU 10A"))

((= blk_name "D_FAN1") (setq blk_name "QUAT HUT GAN TUONG 300x300"))

((= blk_name "D_QT1") (setq blk_name "QUAT TRAN SAI CANH 1,4m + DIMMER"))

((= blk_name "TEN BLK") (setq blk_name "TEN DAY DU..."))

)

Tháng 6 1, 2015

Đây:

(cond ((= blk_name "D_D.CT1.1") (setq blk_name "CONG TAC 1 CHIEU 10A"))((= blk_name "D_FAN1") (setq blk_name "QUAT HUT GAN TUONG 300x300"))
((= blk_name "D_QT1") (setq blk_name "QUAT TRAN SAI CANH 1,4m + DIMMER"))
((= blk_name "TEN BLK") (setq blk_name "TEN DAY DU..."))
)

Vấn đề ở đây chắc là bạn ấy thích có Tiếng Việt có dấu nữa cơ!

Tháng 6 1, 2015

Vấn đề ở đây chắc là bạn ấy thích có Tiếng Việt có dấu nữa cơ

đúng là như thế

Tháng 6 1, 2015

Cả bản vẽ chỉ có vài bản thống kê, k hiểu vài bước link và dataextraction thì làm khó gì bạn ? Việc đọc dữ liệu từ file excel, thống kê, preview chẳng có gì khó, nhưng ketxu nghĩ k cần thiết.

Tháng 6 1, 2015

Thật ra mình là dân hạ tầng san nền, giao thông. Mình cũng ít khi thống kê block. Chỉ là mình thấy các anh chị em trong công ty bên bộ môn điện thống kê bằng count block khá vất vả. Mình nảy ra ý định làm một file dũ liệu chứa tất cả các block bộ môn điện, sau đó mỗi khi thống kê từ cad thì đối chiếu bên file dữ liệu để đổi tên tiếng việt cho block. Mình cũng đã hướng dẫn kết xuất dữ liệu thông qua dataextraction cho họ nhưng họ nói lệnh này dài dòng quá. Bởi vậy mới đề xuất phương án thống kê từ lip để mọi người dể dùng. Thks. Có lẽ áp dụng nữa tự động (líp) và nữa thủ công thôi (đánh lại tên block tiếng việt). :)

Tháng 6 1, 2015

Hơi củ chuối nhưng vẫn đạt mục đích:

http://www.cadviet.com/upfiles/4/141736_tkblk.lsp

Tháng 6 1, 2015

Nếu là củ chuối còn nhai tạm. Củ này không nhai được mới điên.

Tháng 6 1, 2015

Sao vậy bác? Tui test được mà!

Tháng 6 1, 2015

Diễn đàn làm sao ấy nhỉ? Không up file được.

(defun c:BlkQty (/ blk_id blk_len blk_name blks cur_var ent h header_lsp height i ins j len0 lst_blk msp pt row ss str tblobj width width1
width2 x y blk_name1 rn_blk_vn-0 rn_blk_vn)
;; By : Gia Bach, gia_bach @ www.CadViet.com ;;
;;---- PHAN BO SUNG -------------------------------------------------------------------------------------------------
(defun rn_blk_vn-0 ()
(cond ((= blk_name "D_dat.ban cong") (setq blk_name1 "DEN OP TRAN D300, MAM THUY TINH, 220V-1X20W, ANH SANG TRANG"))
((= blk_name "D_dhq_don") (setq blk_name1 "DEN HUYNH QUANG 1,2M GAN TRAN 220V-1X40W, ANH SANG TRANG"))
((= blk_name "D_D.CT1.1") (setq blk_name1 "CONG TAC 1 CHIEU 10A"))
((= blk_name "D_qtuong1")(setq blk_name1 "QUAT GAN TUONG + O CAM DON 02 CUC"))
((= blk_name "D_dat.dentranh")(setq blk_name1 "DEN VACH TUONG CAU THANG, 220V-20W, ANH SANG TRANG "))
((= blk_name "D_denngu") (setq blk_name1 "DEN NGU"))
((= blk_name "D_FAN1") (setq blk_name1 "QUAT HUT GAN TUONG 300X300"))
((= blk_name "D_QT1") (setq blk_name1 "QUAT TRAN SAI CANH 1,4M + DIMMER"))
((= blk_name "D_dat.densuco")(setq blk_name1 "DEN SU CO ( 3H), 220V-2X4W, ANH SANG TRANG + O CAM DON 02 CUC"))
((= blk_name "D_dhq_don") (setq blk_name1 "DEN HUYNH QUANG 0.6M GAN TRAN 220V-1X20W, ANH SANG TRANG "))
((= blk_name "D_D.CT2.2") (setq blk_name1 "CONG TAC 2 CHIEU 10A"))
((= blk_name "D_denmo") (setq blk_name1 "DON MO"))
((= blk_name "D_denkinh") (setq blk_name1 "DEN CUA KINH"))
((= blk_name "D_denbep") (setq blk_name1 "DEN PHONG BEP"))
((= blk_name "D_denvesinh") (setq blk_name1 "DEN NHA VE SINH")))
)
(defun rn_blk_vn ()
(cond ((= blk_name1 "D_dat.ban cong") (setq blk_name1 "\U+0110\U+00C8N \U+1ED0P TR\U+1EA6N D300, M\U+00C2M TH\U+1EE6Y TINH, 220V-1X20W, ANH SANG TR\U+1EAENG"))
((= blk_name1 "D_dhq_don") (setq blk_name1 "\U+0110\U+00C8N HU\U+1EF2NH QUANG 1,2M G\U+1EAEN TR\U+1EA6N 220V-1X40W, \U+00C1NH S\U+00C1NG TR\U+1EAENG "))
((= blk_name1 "D_D.CT1.1") (setq blk_name1 "C\U+00D4NG T\U+1EAEC 1 CHI\U+1EC0U 10A"))
((= blk_name1 "D_qtuong1")(setq blk_name1 "QU\U+1EA0T G\U+1EAEN T\U+01AF\U+1EDCNG + \U+1ED4 C\U+1EAEM \U+0110\U+01A0N 02 C\U+1EF0C"))
((= blk_name1 "D_dat.dentranh")(setq blk_name1 "\U+0110\U+00C8N V\U+00C1CH T\U+01AF\U+1EDCNG C\U+1EA6U THANG, 220V-20W, \U+00C1NH S\U+00C1NG TR\U+1EAENG" ))
((= blk_name1 "D_denngu") (setq blk_name1 "\U+0110\U+00C8N NG\U+1EE6"))
((= blk_name1 "D_FAN1") (setq blk_name1 "QU\U+1EA0T H\U+00DAT G\U+1EAEN T\U+01AF\U+1EDCNG 300X300"))
((= blk_name1 "D_QT1") (setq blk_name1 "QU\U+1EA0T TR\U+1EA6N S\U+0226I C\U+00C1NH 1,4M + DIMMER"))
((= blk_name1 "D_dat.densuco")(setq blk_name1 "\U+0110\U+00C8N S\U+1EF0 C\U+1ED0 ( 3H), 220V-2X4W, \U+00C1NH S\U+00C1NG TR\U+1EAENG + \U+1ED4 C\U+1EAEM \U+0110\U+01A0N 02 C\U+1EF0C"))
((= blk_name1 "D_dhq_don") (setq blk_name1 "\U+0110AN HU\U+1EF2NH QUANG 0.6M G\U+1EAEN TR\U+1EA6N 220V-1X20W, \U+00C1NH S\U+00C1NG TR\U+1EAENG"))
((= blk_name1 "D_D.CT2.2") (setq blk_name1 "C\U+00D4NG T\U+1EAEC 2 CHI\U+1EC0U 10A"))
((= blk_name1 "D_denmo") (setq blk_name1 "\U+0110AN M\U+1EDC"))
((= blk_name1 "D_denkinh") (setq blk_name1 "\U+0110\U+00C8N C\U+1EECA KINH"))
((= blk_name1 "D_denbep") (setq blk_name1 "\U+0110\U+00C8N PHONG B\U+1EBEP"))
((= blk_name1 "D_denvesinh") (setq blk_name1 "\U+0110\U+00C8N NHU\+00C0 V\U+1EC6 SINH")))
)
;; -------------------------------------------------------------------------------------------------------------------
(defun TxtWidth (val h msp / txt minp maxp)
(setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h))
(vla-getboundingbox txt 'minp 'maxp)
(vla-erase txt)
(- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))))
(defun GetOrCreateTableStyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty)
(setq objTblStyDic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE"))
(foreach itm (vlax-for itm objTblStyDic (setq tabLst (append tabLst (list itm))))
(if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-name (list itm)))))
(setq nameLst (append nameLst (list name)))))
(if (not (vl-position tbl_name nameLst))
(vla-addobject objTblStyDic tbl_name "AcDbTableStyle"))
(setq objTblSty (vla-item objTblStyDic tbl_name)
TxtSty (variant-value (vla-getvariable *adoc "TextStyle")))
(mapcar '(lambda (x) (vla-settextstyle objTblSty x TxtSty)) (list actitlerow acheaderrow acdatarow))
(vla-setvariable *adoc "CTableStyle" tbl_name))
(defun GetObjectID (obj)
(if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
(vlax-invoke-method (vla-get-utility *adoc) 'GetObjectIdString obj :vlax-false)
(vla-get-objectid obj))) ;main
(if (setq ss (ssget (list (cons 0 "INSERT"))))
(progn (vl-load-com)
(setq i -1
len0 8)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq blk_name (vla-get-name (vlax-ename->vla-object ent)))
(rn_blk_vn-0) ; Them o day
(if (> (setq blk_len (strlen blk_name1)) len0)
(setq str blk_name1
len0 blk_len))
(if (not (assoc blk_name lst_blk))
(setq lst_blk (cons (cons blk_name 1) lst_blk))
(setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk)))) (assoc blk_name lst_blk) lst_blk)))
)
(setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)))))
(setq cur_var (mapcar 'getvar '("DYNMODE" "DYNPROMPT")))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") '(1 1))
(initget "Yes No")
(setq ins (getkword "\nChen ki hieu Block [Yes/No ]  : "))
(or ins (setq ins "Yes"))
(mapcar 'setvar '("DYNMODE" "DYNPROMPT") cur_var)
(or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale"))))
(initget 6)
(setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
(if h
(setq *h* h)
(setq h *h*))
(setq *adoc (vla-get-activedocument (vlax-get-acad-object))
msp (vla-get-modelspace *adoc)
blks (vla-get-blocks *adoc))
(setq width1 (* 2 (TxtWidth "STT" h msp))
width (* 2 (TxtWidth "So luong" h msp))
height (* 2 h))
(if str
(setq width2 (* 1.1 (TxtWidth (strcase str) h msp)))
(setq width2 width))
(if (> h 3)
(setq width (* (fix (/ width 10)) 10)
width1 (* (fix (/ width1 10)) 10)
width2 (* (fix (/ width2 10)) 10)
height (* (fix (/ height 5)) 5)))
(GetOrCreateTableStyle "CadViet")
(setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width))
(vla-put-regeneratetablesuppressed TblObj :vlax-true)
(vla-setcolumnwidth TblObj 0 width1)
(vla-setcolumnwidth TblObj 1 width2)
(vla-put-vertcellmargin TblObj (* 0.75 h))
(vla-put-horzcellmargin TblObj (* 0.75 h))
(mapcar '(lambda (x) (vla-settextheight TblObj x h)) (list actitlerow acheaderrow acdatarow))
(mapcar '(lambda (x) (vla-setalignment TblObj x 2)) (list actitlerow acheaderrow acdatarow))
(vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (vla-mergecells TblObj 0 0 0 3)))))
(vla-settext TblObj 0 0 "B\U+0226NG TH\U+1ED0NG K\U+00CA")
(setq j -1
header_lsp (list "STT" "T\U+00CAN" "\U+0110\U+01A0N V\U+1ECA" "S\U+1ED0 L\U+01AF\U+1EE2NG" "K\U+00DD HI\U+1EC6U"))
(repeat (length header_lsp) (vla-settext TblObj 1 (setq j (1+ j)) (nth j header_lsp)))
(setq row 2
i 1)
(foreach pt lst_blk
(setq blk_name (car pt)
blk_name1 blk_name ; Them
j -1)

(rn_blk_vn) ; Them o day
(mapcar '(lambda (x) (vla-settext TblObj row (setq j (1+ j)) x)) (list i blk_name1 "C\U+00C1I" (cdr pt))) ; blk_name = blk_name1
(if (= ins "Yes")
(vlax-for blk blks
(if (= (vla-get-name blk) blk_name)
(vla-setblocktablerecordid TblObj row 4 (GetObjectID blk) :vlax-true))))

(vla-setcellalignment TblObj row 1 7)
(vla-setcellalignment TblObj row 3 9)
(setq row (1+ row)
i (1+ i)))
(vla-put-regeneratetablesuppressed TblObj :vlax-false)
(vlax-release-object TblObj)))
(princ))

Tháng 6 1, 2015

Vậy mỗi lần có block mói lại phải sủa lisp đổi tên cả 2 phần hả bạn? Mà đổi tên tiếng việt như trong lisp hơi bị đuối đấy.

Đăng nhập

[Nhờ giúp đỡ] Lisp đếm block BLKQTY

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

pinggun 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

ketxu 2.984

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

gia_bach 1.549

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

pinggun 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

HoangSon614 66

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

gia_bach 1.549

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

HoangSon614 66

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

HoangSon614 66

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

Tue_NV 3.912

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

dihoathienvu 0

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

vandv 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

vandv 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

Tue_NV 3.912

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

vandv 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

quocmanh04tt 635

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

quocmanh04tt 635

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

Tue_NV 3.912

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

vandv 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

ketxu 2.984

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

vandv 1