Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
pinggun

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

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

pinggun    1

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 theo pinggun
  • Vote giảm 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.652

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 ?

  • Vote tăng 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
gia_bach    1.442

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))))

 

 

 
  • Vote tăng 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
HoangSon614    66

 

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, tìm mãi mới được cái lisp đúng với nhu cầu công việc

Xin lỗi gia_bach, nhờ gia_bach bớt chút thời gian sửa giúp mình font có dấu được không? (font vni-helve nhé)

Cảm ơn gia_bach 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
gia_bach    1.442

Lisp rất tuyệt vời, tìm mãi mới được cái lisp đúng với nhu cầu công việc

Xin lỗi gia_bach, nhờ gia_bach bớt chút thời gian sửa giúp mình font có dấu được không? (font vni-helve nhé)

Cả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))
  • Vote tăng 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
HoangSon614    66

 

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.

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

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 à

  • Vote tăng 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

 

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

 

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

thanks bạn nha

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

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.

102116_table_cad1_1.png

 

 

102116_data1.png

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

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.

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

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é!

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    385

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.

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    385

 

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..."))

)

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

 

Đâ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ơ!

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

 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. 

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

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). :) 

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    385

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))

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

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.

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

Đăng nhập để thực hiện theo  

×