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  
THIENDANTU_TDT

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

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

- 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

  • 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
quocmanh04tt    385

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.

  • 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

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

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

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

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.

15454_tkblock.png

  • 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

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

  • 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
Tot77    501

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))
  • 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
SƠN MÈO    1

 

Đượ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

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
SƠN MÈO    1

 

Đượ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 

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  

×