[Nhờ Viết Lisp] Bóc Khối Lượng Block Dynamic Tích Hợp Nhiều Đối Tượng

[THIENDANTU_TDT 0]

- Nhờ anh em viết dùm mình lisp bóc khối lượng block dynamic tích hợp nhiều đối tượng ( xem file đính kèm).

 

- có một block chứa nhiều đối tượng, như co 90, co 114, co 168 .... đánh lệnh quét block sẽ bóc ra được đối tượng đang hiện hành ( như co 90). 

 

Xin cảm ơn!

 

 

http://www.cadviet.com/upfiles/6/57418_drawing2.dwg

[quocmanh04tt 638]

Bạn dịch cho mình mấy cụm này sang tiếng hàn, để mình đưa vào bảng thống kê giúp bạn:

1. Bảng thống kê khối lượng

2. STT (số thứ tự)

3. Tên (chủng loại co...)...

4. Cái (chiếc)...

5. Đơn vị

6. Số lượng

*** Đại ý như vậy, bạn dịch như thế nào để cho phù hợp với bảng thống kê của bạn.

[THIENDANTU_TDT 0]

Cảm ơn bạn!

 

- Mình không biết tiếng Hàn rôi.

 

Mình xin đính kèm lại file với ví dụ rõ ràng hơn, vd: trong file có một đối tượng block dynamic có tên là TEE STK, block TEE STK có chứa nhiều đối tượng con như 50x25, 50x32, 50x40, 50...

Trong file cad mình copy block TEE STK làm 4, chọn lần lượt theo thứ tự từng block là 50x25, 50x32, 50x40, 50...

 

- Đánh lệnh quét tất cả sẽ đếm được các block là TEE STK 50x25, TEE STK 50x32, TEE STK 50x40, TEE STK 50...

 

http://www.cadviet.com/upfiles/6/57418_tee_stk.dwg

[quocmanh04tt 638]

Ồ vậy mà...! Khi làm lisp, lấy tên block nó ra tiếng Hàn, chỗ thì được chỗ thì lỗi, làm mình phải cài thêm tiếng Hàn cho máy để kiểm tra LISP...

Đây là lisp sửa lại từ BLKQTY của Bác GiaBach (Nếu muốn đổi chiều cao chữ thì gõ lệnh TEXTSIZE nhập giá trị trước khi chạy Lisp).

(defun c:tt  (/ LM:al-effectivename LM:getdynprops blk blk_name ent i lst_blk pt row ss tblobj x y htxt)
 (defun LM:al-effectivename  (ent / blk rep)
  (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
   (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag")))))
            (setq rep (handent (cdr (assoc 1005 rep)))))
    (setq blk (cdr (assoc 2 (entget rep))))))
  blk)
 (defun LM:getdynprops  (blk)
  (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
          (vlax-invoke blk 'getdynamicblockproperties)))
 (or (> (setq htxt (getvar 'TEXTSIZE)) 0) (setq htxt (setvar 'TEXTSIZE 250)))
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn (vl-load-com)
         (setq i -1)
         (while (setq ent (ssname ss (setq i (1+ i))))
          (setq blk (vlax-ename->vla-object ent))
          (setq blk_name (strcat (LM:al-effectivename ent) ": " (cdar (LM:getdynprops blk))))
          (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 pt     (getpoint "\nSpecify insertion point: ")
               TblObj (vla-addtable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
                                    (vlax-3d-point pt)
                                    (+ (length lst_blk) 2)
                                    4
                                    (* 1.5 htxt)
                                    (* 6 htxt)))
         (vla-SetColumnWidth TblObj 0 (* 4 htxt))
         (vla-SetColumnWidth TblObj 1 (* 12 htxt))
         (vla-put-vertcellmargin TblObj (* 0.2 htxt))
         (mapcar '(lambda (x y) (vla-setTextHeight TblObj x y))
                 (list acTitleRow acHeaderRow acDataRow)
                 (list htxt htxt (* 0.75 htxt)))
         (mapcar '(lambda (x) (vla-setAlignment TblObj x 8)) (list acTitleRow acHeaderRow acDataRow))
         (vla-MergeCells TblObj 0 0 0 2)
         (vla-setText TblObj 0 0 "Bang thong ke khoi luong")
         (vla-setText TblObj 1 0 "STT")
         (vla-setText TblObj 1 1 "Ten")
         (vla-setText TblObj 1 2 "Don vi")
         (vla-setText TblObj 1 3 "So luong")
         (setq row 2
               i   1)
         (foreach pt  lst_blk
          (vla-setText TblObj row 0 (itoa i))
          (vla-setText TblObj row 1 (car pt))
          (vla-setText TblObj row 2 "cai")
          (vla-setText TblObj row 3 (itoa (cdr pt)))
          (setq row (1+ row)
                i   (1+ i))))
  (vlax-release-object TblObj))
 (princ))

[THIENDANTU_TDT 0]

Hi @quocmanh04tt,

 

- Mình load lisp báo lỗi là ; error: syntax error, mình không đánh lệnh được, bạn xem lại giúp mình nhé.

[gia_bach 1559]

Hi @quocmanh04tt,

 

- Mình load lisp báo lỗi là ; error: syntax error, mình không đánh lệnh được, bạn xem lại giúp mình nhé.

Copy code, rồi paste vào file.

[THIENDANTU_TDT 0]

Hi cảm ơn bác @gia_bach.

 

- Mình load được rồi nhưng khi sử dụng chỉ đếm được block dynamic, không đếm được block thường.

 

- Bác @gia_bach xem file đính kèm dùm mình nhé.

.http://www.cadviet.com/upfiles/6/57418_tee_stk__test_lan_1.dwg

[Tot77 508]

Hi cảm ơn bác @gia_bach.

 

- Mình load được rồi nhưng khi sử dụng chỉ đếm được block dynamic, không đếm được block thường.

 

- Bác @gia_bach xem file đính kèm dùm mình nhé.

.http://www.cadviet.com/upfiles/6/57418_tee_stk__test_lan_1.dwg

Được voi đòi lung tung, cung may cái đòi lung tung đó không phải sửa nhiều, xài thử cái này.

(defun c:tt (/ LM:al-effectivename LM:getdynprops blk blk_name ent i lst_blk pt row ss tblobj x y htxt)
 (defun LM:al-effectivename  (ent / blk rep)
  (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
   (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag")))))
            (setq rep (handent (cdr (assoc 1005 rep)))))
    (setq blk (cdr (assoc 2 (entget rep))))))
  blk
 )
 
 (defun LM:getdynprops  (blk)
  (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
          (vlax-invoke blk 'getdynamicblockproperties)))
 
 (or (> (setq htxt (getvar 'TEXTSIZE)) 0) (setq htxt (setvar 'TEXTSIZE 250)))
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn (vl-load-com)
         (setq i -1)
         (while (setq ent (ssname ss (setq i (1+ i))))
          (setq blk (vlax-ename->vla-object ent))
          (setq blk_name
(if (= "*" (substr (cdr (assoc 2 (entget ent))) 1 1))
(strcat (LM:al-effectivename ent) ": " (cdar (LM:getdynprops blk)))
(LM:al-effectivename ent)
))
          (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 pt     (getpoint "\nSpecify insertion point: ")
               TblObj (vla-addtable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
                                    (vlax-3d-point pt) (+ (length lst_blk) 2) 4 (* 1.5 htxt) (* 6 htxt)))
         (vla-SetColumnWidth TblObj 0 (* 4 htxt))
         (vla-SetColumnWidth TblObj 1 (* 12 htxt))
         (vla-put-vertcellmargin TblObj (* 0.2 htxt))
         (mapcar '(lambda (x y) (vla-setTextHeight TblObj x y))
                 (list acTitleRow acHeaderRow acDataRow)
                 (list htxt htxt (* 0.75 htxt)))
         (mapcar '(lambda (x) (vla-setAlignment TblObj x 8)) (list acTitleRow acHeaderRow acDataRow))
         (vla-MergeCells TblObj 0 0 0 2)
         (vla-setText TblObj 0 0 "Bang thong ke khoi luong")
         (vla-setText TblObj 1 0 "STT")
         (vla-setText TblObj 1 1 "Ten")
         (vla-setText TblObj 1 2 "Don vi")
         (vla-setText TblObj 1 3 "So luong")
         (setq row 2
               i   1)
         (foreach pt  lst_blk
          (vla-setText TblObj row 0 (itoa i))
          (vla-setText TblObj row 1 (car pt))
          (vla-setText TblObj row 2 "cai")
          (vla-setText TblObj row 3 (itoa (cdr pt)))
          (setq row (1+ row)
                i   (1+ i))))
  (vlax-release-object TblObj))
 (princ))

[THIENDANTU_TDT 0]

 

Được voi đòi lung tung, cung may cái đòi lung tung đó không phải sửa nhiều, xài thử cái này.

 

Cảm ơn bác @Tot77!, lisp sài rất mượt.

[SƠN MÈO 0]

 

Được voi đòi lung tung, cung may cái đòi lung tung đó không phải sửa nhiều, xài thử cái này.

(defun c:tt (/ LM:al-effectivename LM:getdynprops blk blk_name ent i lst_blk pt row ss tblobj x y htxt)
 (defun LM:al-effectivename  (ent / blk rep)
  (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
   (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag")))))
            (setq rep (handent (cdr (assoc 1005 rep)))))
    (setq blk (cdr (assoc 2 (entget rep))))))
  blk
 )
 
 (defun LM:getdynprops  (blk)
  (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
          (vlax-invoke blk 'getdynamicblockproperties)))
 
 (or (> (setq htxt (getvar 'TEXTSIZE)) 0) (setq htxt (setvar 'TEXTSIZE 250)))
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn (vl-load-com)
         (setq i -1)
         (while (setq ent (ssname ss (setq i (1+ i))))
          (setq blk (vlax-ename->vla-object ent))
          (setq blk_name
(if (= "*" (substr (cdr (assoc 2 (entget ent))) 1 1))
(strcat (LM:al-effectivename ent) ": " (cdar (LM:getdynprops blk)))
(LM:al-effectivename ent)
))
          (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 pt     (getpoint "\nSpecify insertion point: ")
               TblObj (vla-addtable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
                                    (vlax-3d-point pt) (+ (length lst_blk) 2) 4 (* 1.5 htxt) (* 6 htxt)))
         (vla-SetColumnWidth TblObj 0 (* 4 htxt))
         (vla-SetColumnWidth TblObj 1 (* 12 htxt))
         (vla-put-vertcellmargin TblObj (* 0.2 htxt))
         (mapcar '(lambda (x y) (vla-setTextHeight TblObj x y))
                 (list acTitleRow acHeaderRow acDataRow)
                 (list htxt htxt (* 0.75 htxt)))
         (mapcar '(lambda (x) (vla-setAlignment TblObj x 8)) (list acTitleRow acHeaderRow acDataRow))
         (vla-MergeCells TblObj 0 0 0 2)
         (vla-setText TblObj 0 0 "Bang thong ke khoi luong")
         (vla-setText TblObj 1 0 "STT")
         (vla-setText TblObj 1 1 "Ten")
         (vla-setText TblObj 1 2 "Don vi")
         (vla-setText TblObj 1 3 "So luong")
         (setq row 2
               i   1)
         (foreach pt  lst_blk
          (vla-setText TblObj row 0 (itoa i))
          (vla-setText TblObj row 1 (car pt))
          (vla-setText TblObj row 2 "cai")
          (vla-setText TblObj row 3 (itoa (cdr pt)))
          (setq row (1+ row)
                i   (1+ i))))
  (vlax-release-object TblObj))
 (princ))

ĐÁNH LỆNH 'TT' KO ĐƯỢC BÁC AH

[SƠN MÈO 0]

 

Được voi đòi lung tung, cung may cái đòi lung tung đó không phải sửa nhiều, xài thử cái này.

(defun c:tt (/ LM:al-effectivename LM:getdynprops blk blk_name ent i lst_blk pt row ss tblobj x y htxt)
 (defun LM:al-effectivename  (ent / blk rep)
  (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
   (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag")))))
            (setq rep (handent (cdr (assoc 1005 rep)))))
    (setq blk (cdr (assoc 2 (entget rep))))))
  blk
 )
 
 (defun LM:getdynprops  (blk)
  (mapcar '(lambda (x) (cons (vla-get-propertyname x) (vlax-get x 'value)))
          (vlax-invoke blk 'getdynamicblockproperties)))
 
 (or (> (setq htxt (getvar 'TEXTSIZE)) 0) (setq htxt (setvar 'TEXTSIZE 250)))
 (if (setq ss (ssget (list (cons 0 "INSERT"))))
  (progn (vl-load-com)
         (setq i -1)
         (while (setq ent (ssname ss (setq i (1+ i))))
          (setq blk (vlax-ename->vla-object ent))
          (setq blk_name
(if (= "*" (substr (cdr (assoc 2 (entget ent))) 1 1))
(strcat (LM:al-effectivename ent) ": " (cdar (LM:getdynprops blk)))
(LM:al-effectivename ent)
))
          (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 pt     (getpoint "\nSpecify insertion point: ")
               TblObj (vla-addtable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
                                    (vlax-3d-point pt) (+ (length lst_blk) 2) 4 (* 1.5 htxt) (* 6 htxt)))
         (vla-SetColumnWidth TblObj 0 (* 4 htxt))
         (vla-SetColumnWidth TblObj 1 (* 12 htxt))
         (vla-put-vertcellmargin TblObj (* 0.2 htxt))
         (mapcar '(lambda (x y) (vla-setTextHeight TblObj x y))
                 (list acTitleRow acHeaderRow acDataRow)
                 (list htxt htxt (* 0.75 htxt)))
         (mapcar '(lambda (x) (vla-setAlignment TblObj x 8)) (list acTitleRow acHeaderRow acDataRow))
         (vla-MergeCells TblObj 0 0 0 2)
         (vla-setText TblObj 0 0 "Bang thong ke khoi luong")
         (vla-setText TblObj 1 0 "STT")
         (vla-setText TblObj 1 1 "Ten")
         (vla-setText TblObj 1 2 "Don vi")
         (vla-setText TblObj 1 3 "So luong")
         (setq row 2
               i   1)
         (foreach pt  lst_blk
          (vla-setText TblObj row 0 (itoa i))
          (vla-setText TblObj row 1 (car pt))
          (vla-setText TblObj row 2 "cai")
          (vla-setText TblObj row 3 (itoa (cdr pt)))
          (setq row (1+ row)
                i   (1+ i))))
  (vlax-release-object TblObj))
 (princ))

LISP BỊ LỖI HAY SAO VẬY BÁC AH, ĐÁNH LÊNH TT KO ĐC