Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
38 replies to this topic

#21 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 01 June 2015 - 08:34 PM

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

http://www.cadviet.c...41736_tkblk.lsp


  • 0

#22 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 01 June 2015 - 08:42 PM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#23 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 01 June 2015 - 08:44 PM

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


  • 0

#24 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 01 June 2015 - 08:52 PM

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


  • 0

#25 vandv

vandv

    Edu level: no10

  • Members
  • PipPip
  • 70 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 01 June 2015 - 09:20 PM

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.


  • 0

#26 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 01 June 2015 - 09:32 PM

Ở phần chữ không có dấu là để lấy bề rộng cột chứa tên thiết bị.

Theo tui biết nếu làm trực tiếp trong lisp thì chỉ có cách ấy.


  • 0

#27 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 02 June 2015 - 06:10 AM

Ở phần chữ không có dấu là để lấy bề rộng cột chứa tên thiết bị.

Theo tui biết nếu làm trực tiếp trong lisp thì chỉ có cách ấy.

 

-Cái này phải mất công bạn vandv phải dùng thêm chương trình để chuyển nữa rồi ^_^

- Tìm bề rộng cột đâu cần phải ghi chữ không dấu

Chữ có dấu tìm bề rộng nó cũng tương đương với chũ không dấu.

Bạn kiểm tra lại nhé!

 

 

-Theo mình cách hay nhất vẫn nên sử dụng description của block để mô tả. Sau đó dùng Lisp để đọc

Việc này cũng khá nhanh. Vì trong lệnh BEDIT cũng vốn đã hiển thị tên Block với mô tả description. Bạn ấy lại đặt Block theo tên bắt đầu bằng chữ D_ nên việc sử dụng description của block để mô tả rất dễ dàng


  • 0

#28 vandv

vandv

    Edu level: no10

  • Members
  • PipPip
  • 70 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 02 June 2015 - 08:39 AM

-Cái này phải mất công bạn vandv phải dùng thêm chương trình để chuyển nữa rồi ^_^

- Tìm bề rộng cột đâu cần phải ghi chữ không dấu

Chữ có dấu tìm bề rộng nó cũng tương đương với chũ không dấu.

Bạn kiểm tra lại nhé!

 

 

-Theo mình cách hay nhất vẫn nên sử dụng description của block để mô tả. Sau đó dùng Lisp để đọc

Việc này cũng khá nhanh. Vì trong lệnh BEDIT cũng vốn đã hiển thị tên Block với mô tả description. Bạn ấy lại đặt Block theo tên bắt đầu bằng chữ D_ nên việc sử dụng description của block để mô tả rất dễ dàng

Mình đã tạo description của block. Bác Tue_NV chỉ mình cách dùng lisp để thống ke với http://www.cadviet.c...ong_ke_dien.dwg


  • 0

#29 vandv

vandv

    Edu level: no10

  • Members
  • PipPip
  • 70 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 02 June 2015 - 10:07 AM

9 đấm còn 1 nhéo, Bác ra tay giúp mình chút :) :) :)


  • 0

#30 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 02 June 2015 - 12:23 PM

@Bác Tue_NV:

1. Chữ có dấu ở dạng hexa nên nhiều ký tự quá bác ạ! Em chưa biết cách giải quyết.???

2. Description em làm được rồi, nhưng tiếng Việt vẫn bị nhảy tung tăng.

PS: Muốn hiện tiếng Việt thì trong Description lại phải để Hexa.


  • 0

#31 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 02 June 2015 - 02:27 PM

@vandv:

+ Description phải dùng hexa.

+ Cách dùng đơn giản nhất để nhập mã hexa: http://www.cadviet.c...thao-code-lisp/

Đây là lisp:

(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_obj defx blk_def)
;; 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)))
;; ------------- Lay Description -------------------
(setq blk_obj (vlax-ename->vla-object ent)
blk_def (vla-item
(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-effectivename blk_obj))
defx (vl-catch-all-apply (function (lambda () (vla-get-comments blk_def)))))
;;-------------Thay doi Len-------------------------
(if (> (setq blk_len (strlen defx)) len0)
(setq str defx
len0 blk_len))
(setq blk_name (list blk_name defx)) ; Them Description
(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 (car x)) (car (car y)))))) ; Them car
(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.25 (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+1EA2NG TH\U+1ED0NG K\U+00CA")
(vla-setcelltextheight TblObj 0 0 (* h 2))
(setq j -1
header_lsp (list "STT" "T\U+00CAN G\U+1ECCI" "\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)
j -1)
(mapcar '(lambda (x) (vla-settext TblObj row (setq j (1+ j)) x))
(list i (cadr blk_name) "C\U+00C1I" (cdr pt))) ; Them cadr
(if (= ins "Yes")
(vlax-for
blk blks
(if (= (vla-get-name blk) (car blk_name)) ; Them car
(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))


  • 0

#32 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 03 June 2015 - 07:12 AM

@Bác Tue_NV:

1. Chữ có dấu ở dạng hexa nên nhiều ký tự quá bác ạ! Em chưa biết cách giải quyết.???

2. Description em làm được rồi, nhưng tiếng Việt vẫn bị nhảy tung tăng.

PS: Muốn hiện tiếng Việt thì trong Description lại phải để Hexa.

 

Trong Description Không cần phải để Hexa

Ban quocmanh và vandv thử lisp này nhé

(Trên file tạo description của vandv)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69520-nho-gia-p-do-lisp-dem-block-blkqty/
(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 (cdr(assoc 4 (entget(tblobjname "block" (vla-get-effectivename (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.05 (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)
        (= (cdr(assoc 4 (entget(tblobjname "block" (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))

  • 1

#33 vandv

vandv

    Edu level: no10

  • Members
  • PipPip
  • 70 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 03 June 2015 - 09:19 AM

Chạy ra rồi làm sao đổi tên block có description đây bác Tue_NV


  • 0

#34 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 04 June 2015 - 01:25 PM

Cám ơn bác Tue_VN!

Uh, dùng vla-get-comments thì bị lỗi font, còn dùng  assoc 4 kia thì không bị.


  • 0

#35 HOKAGE1202

HOKAGE1202

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 09 July 2015 - 05:17 PM

cho e hỏi mấy bak tý

 e tải lish (blkqty) về mà dùng bị báo lỗi nhỉ???????????

e dùng cad 2008 nhé


  • 0

#36 nguyenhuy68

nguyenhuy68

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 04 August 2015 - 11:06 AM

Em nhờ các cao thủ viết thêm vào lisp của bác gia_bach nội dung như sau:

-         Trong bản vẽ dưới đây có 2 loại dữ liệu text: D15,L...; D20,L... .Và mỗi loại có 2 mầu khác nhau là mầu 15, 80.

(D15,L...: đường kính 15, chiều dài)

-         Em muốn ra kết quả tổng tất cả các text sau chữ “D15,L” và “D20,L” cụ thể:

+ D15,L... mầu 15

+ D20,L... mầu 15

+ D15,L... mầu 80

+ D20,L... mầu 80.

Em xin cảm ơn trước ạ!

http://www.cadviet.c...4817_sdkg_1.dwg


  • -1

#37 hoainam1993

hoainam1993

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 August 2015 - 01:30 PM

Hơi củ chuối nhưng vẫn đạt mục đích:
http://www.cadviet.c...41736_tkblk.lsp


Cái này mình thấy tốt rồi đó!! đối với mình đây là đẹp rồi. Không cần cái cao siêu
  • 0
Công ty chúng tôi chuyên in túi giấy giá rẻ tphcm, in nhãn mác sản phẩm tphcm, in nhãn decal giấy tphcm và nhiều dịch vụ in khác

#38 HONGDUY70

HONGDUY70

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 18 September 2015 - 11:38 AM

Các bác giúp em với, em load lis 102517_blkqty4 về autoad 2015 64 bit dùng win 7 64 bit. Nó hiện thị load ok. vào đánh lệnh thì không được.

Dùng lis 102517_blkqty4 này qua các máy khác phiên bản cad 2007 thi ok.

Mong cá bác trên điễn dàn giúp đỡ.

 

 

http://www.cadviet.c...517_blkqty4.lsp


  • 0

#39 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 18 September 2015 - 01:28 PM

Các bác giúp em với, em load lis 102517_blkqty4 về autoad 2015 64 bit dùng win 7 64 bit. Nó hiện thị load ok. vào đánh lệnh thì không được.

Dùng lis 102517_blkqty4 này qua các máy khác phiên bản cad 2007 thi ok.

Mong cá bác trên điễn dàn giúp đỡ.

 

 

http://www.cadviet.c...517_blkqty4.lsp

Lisp này chạy ngon trên CAD2015 64bit nhé.

 

"đánh lệnh thì không được."  : nghĩa là sao?

Nếu không có thông tin gì khác thì đến thầy bói cũng pótay.


  • 0