Đến nội dung


Hình ảnh
- - - - -

[Yêu Cầu] Nhờ Các Bác Sửa Dùm Lisp Thống Kê Text Phổ Biến Cho Ae Xd


  • Please log in to reply
15 replies to this topic

#1 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 06 September 2016 - 12:50 PM

AE XD tụi mình hay gặp phải cái tình huống này, mà làm thủ công thì hơi cực nếu mặt bằng công trình tương phức tạp

 

dc5ryv10u4124lbhv.jpg

 

Mình có tìm trên diễn đàn được lisp thống kê text của bác Gia Bach trong bài http://www.cadviet.c...-lisp-dem-text/ rất hay, nhưng để áp dụng cho AE XD thì hơi thiếu 1 chút xíu

 

dc5s6m80wp3lplnxv.jpg

 

Nhờ các bác sửa dùm ra KQ như hình sau

dc5s0obkkvpuafr77.jpg

 

Đây là lisp của bác Gia Bach và file mẫu đính kèm (có trình bày cụ thể Y/C)

Thanks các bác quan tâm vấn đề của em !

http://www.cadviet.c...169_tk_text.rar

 

 


  • -1

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 06 September 2016 - 04:41 PM

Bạn thử xem: 

(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1 ee); thong ke text
;;  By : Gia Bach, Copyright? December 2010                    ;;
;;  Contact : gia_bach @  www.CadViet.com                      ;;
  (defun TxtWidth (val msp / txt minp maxp)
    (vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)
    (vla-Erase txt)
    (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )
  ;main
  (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
    (progn
      (vl-load-com)
      (princ "\nChon cac Text de thong ke :")
      (if (setq ss (ssget(list (cons 0 "TEXT"))))
(progn
 (setq i -1 len0 8)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq str(cdr(assoc 1 (entget ent ))))
   (if (> (setq str_len (strlen str)) len0)
     (setq str0 str len0 str_len) )
   (if (not (assoc str lst))
     (setq lst (cons (cons str 1) lst))
     (setq lst (subst (cons str (1+ (cdr (assoc str lst))))
      (assoc str lst) lst)))     )
 (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (or *h* (setq *h* 175))
 (initget 6)
 (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
 (if h (setq *h* h) (setq h *h*) )
 (setq width0 (* 3 h(TxtWidth "STT" msp))
height (* 2 h))
 (if str0
   (setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))
   (setq width1 (* 2 h(TxtWidth "Ten Dam" msp))))
 (if (> h 3)
   (setq width0 (* (fix (/ width0 10))10)
 width1 (* (fix (/ width1 10))10)
 height (* (fix (/ height 5))5)))
 (setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 5 height width1))
 (vla-put-regeneratetablesuppressed TblObj :vlax-true)
 (vla-put-vertcellmargin TblObj (* 0.25 h))
 (vla-put-horzcellmargin TblObj (* 0.75 h))
 (vla-SetColumnWidth TblObj 0 width0)
 (vla-SetColumnWidth TblObj 2 (* 2 h(TxtWidth "So luong" msp)))
 (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
 (list acTitleRow acHeaderRow acDataRow) )
 (mapcar '(lambda (x)(vla-setAlignment TblObj x 8))
 (list acTitleRow acHeaderRow acDataRow))
 (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 2)) )))
 (vla-setText TblObj 0 0 "Bang thong ke")
 (vla-setText TblObj 1 0 "STT")
 (vla-setText TblObj 1 1 "Ten dam")
 (vla-setText TblObj 1 2 "Kich thuoc")
 (vla-setText TblObj 1 3 "So luong")
 (vla-setText TblObj 1 4 "chi tiet xem ban ve")
 (setq i 1 row 2 )
 (princ lst)
 (foreach e lst
   (vla-setText TblObj row 0 (itoa i))
   (vla-setText TblObj row 1 (substr (car e) 1
  (- (strlen (car e)) (strlen (vl-string-left-trim "ABCDEFGHIKLMNOPQRSTUVXY+-*/!@#1234567890 " (car e))))
))
   (vla-setText TblObj row 2 (vl-string-trim "()" (vl-string-left-trim "ABCDEFGHIKLMNOPQRSTUVXY+-*/!@#1234567890 " (car e))))
   (vla-setText TblObj row 3 (cdr e))
   (vla-SetCellAlignment TblObj row 1 7)
   (vla-SetCellAlignment TblObj row 2 9)
   (setq row (1+ row) i (1+ i)) )
 (vla-put-regeneratetablesuppressed TblObj :vlax-false)
 (vlax-release-object TblObj)   )
(alert "Khong chon duoc Text.")    )
      (princ)  )
    (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")   )  )

  • 1

#3 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 06 September 2016 - 05:25 PM

Tuyệt vời ông mặt trời bác Tue_NV ,thanks bác nhiều !

Còn chút chưa trình bày đẹp lắm ạ : tất cả các cell căn lề midle center (cái này chỉnh thủ công cũng nhanh, nhưng làm nhiều tầng sợ có quên vài ba cái)

Còn phần STT và SL <10 bác thêm prefix "0" dùm em được không bác ! Cái này cũng khá quan trọng không là Sếp la


  • -1

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 06 September 2016 - 10:08 PM

Tuyệt vời ông mặt trời bác Tue_NV ,thanks bác nhiều !

Còn chút chưa trình bày đẹp lắm ạ : tất cả các cell căn lề midle center (cái này chỉnh thủ công cũng nhanh, nhưng làm nhiều tầng sợ có quên vài ba cái)

Còn phần STT và SL <10 bác thêm prefix "0" dùm em được không bác ! Cái này cũng khá quan trọng không là Sếp la

 

Mình e là sẽ có nhiều thứ "phát sinh" nữa đó. Bạn hãy dạo hết 1 lượt coi còn có bổ sung gì nữa không? Chứ lắt nhắc là mệt lắm đó ^_^


  • 0

#5 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 06 September 2016 - 11:11 PM

Em test nhiều trường hợp rồi, mấy cái D1 không viết hoa, hay viết tiếng việt thì thống kê không đúng, mà cái này cũng không cần sửa vì không cần thiết

Mấy cái text sai mẫu là không TK dc

Căn lề, chỉnh midle center trong talbe hoài mà không đều giữa text và khung

Bác chốt dùm em 2 vđ trên là OK rồi.  I swear, by the moon and the star in the sky ^.^


  • 0

#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 September 2016 - 06:40 AM

Em test nhiều trường hợp rồi, mấy cái D1 không viết hoa, hay viết tiếng việt thì thống kê không đúng, mà cái này cũng không cần sửa vì không cần thiết

Mấy cái text sai mẫu là không TK dc

Căn lề, chỉnh midle center trong talbe hoài mà không đều giữa text và khung

Bác chốt dùm em 2 vđ trên là OK rồi.  I swear, by the moon and the star in the sky ^.^

 

2 vấn đề của bạn đây. Xử lý TH viết hoa, thường

(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1 ee); thong ke text
;;  By : Gia Bach, Copyright? December 2010                    ;;
;;  Contact : gia_bach @  www.CadViet.com                      ;;
  (defun TxtWidth (val msp / txt minp maxp)
    (vla-getBoundingBox (setq txt (vla-AddText msp val (vlax-3d-point '(0 0 0)) 1)) 'minp 'maxp)
    (vla-Erase txt)
    (-(car(vlax-safearray->list maxp))(car(vlax-safearray->list minp)))  )
  ;main
  (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0)
    (progn
      (vl-load-com)
      (princ "\nChon cac Text de thong ke :")
      (if (setq ss (ssget(list (cons 0 "TEXT"))))
(progn
 (setq i -1 len0 8)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq str(cdr(assoc 1 (entget ent ))))
   (if (> (setq str_len (strlen str)) len0)
     (setq str0 str len0 str_len) )
   (if (not (assoc str lst))
     (setq lst (cons (cons str 1) lst))
     (setq lst (subst (cons str (1+ (cdr (assoc str lst))))
      (assoc str lst) lst)))     )
 (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))
msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (or *h* (setq *h* 175))
 (initget 6)
 (setq h (getreal (strcat "\nChieu cao chu <" (rtos *h*) "> :")))
 (if h (setq *h* h) (setq h *h*) )
 (setq width0 (* 3 h(TxtWidth "STT" msp))
height (* 2 h))
 (if str0
   (setq width1 (* 1.2 h(TxtWidth (strcase str0) msp)))
   (setq width1 (* 2 h(TxtWidth "Ten Dam" msp))))
 (if (> h 3)
   (setq width0 (* (fix (/ width0 10))10)
 width1 (* (fix (/ width1 10))10)
 height (* (fix (/ height 5))5)))
 (setq pt (getpoint "\nDiem dat Bang :")
TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 5 height width1))
 (vla-put-regeneratetablesuppressed TblObj :vlax-true)
 (vla-put-vertcellmargin TblObj (* 0.25 h))
 (vla-put-horzcellmargin TblObj (* 0.75 h))
 (vla-SetColumnWidth TblObj 0 width0)
 (vla-SetColumnWidth TblObj 2 (* 2 h(TxtWidth "So luong" msp)))
 (mapcar '(lambda (x)(vla-setTextHeight TblObj x h))
 (list acTitleRow acHeaderRow acDataRow) )
 (mapcar '(lambda (x)(vla-setAlignment TblObj x acMiddleCenter))
 (list acTitleRow acHeaderRow acDataRow))
 (vl-catch-all-error-p (vl-catch-all-apply (function(lambda () (vla-MergeCells TblObj 0 0 0 2)) )))
 (vla-setText TblObj 0 0 "Bang thong ke")
 (vla-setText TblObj 1 0 "STT")
 (vla-setText TblObj 1 1 "Ten dam")
 (vla-setText TblObj 1 2 "Kich thuoc")
 (vla-setText TblObj 1 3 "So luong")
 (vla-setText TblObj 1 4 "chi tiet xem ban ve")
 (setq i 1 row 2)
 (princ lst)
 (foreach e lst
   (vla-setText TblObj row 0 (if (< i 10) (strcat "0" (itoa i)) (itoa i)))
   (vla-setText TblObj row 1 (substr (car e) 1
  (- (strlen (car e)) (strlen (vl-string-left-trim "ABCDEFGHIKLMNOPQRSTUVXY+-*/!@#1234567890 " (strcase (car e)))))
))
   (vla-setText TblObj row 2 (vl-string-trim "()" (vl-string-left-trim "ABCDEFGHIKLMNOPQRSTUVXY+-*/!@#1234567890 " (strcase (car e)))))
   (vla-setText TblObj row 3 (cdr e))
   (setq row (1+ row) i (1+ i) ) )
 (vla-put-regeneratetablesuppressed TblObj :vlax-false)
 (vlax-release-object TblObj)   )
(alert "Khong chon duoc Text.")    )
      (princ)  )
    (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")   )  )

  • 0

#7 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 07 September 2016 - 07:55 AM

 - Xử lý TH, toàn bộ ra hoa: không ổn,

VD : 200X300 - xấu

- Nếu có text khác => sai

VD: ghi chú, các mặt cắt không dung block


  • 0

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 September 2016 - 08:29 AM

 - Xử lý TH, toàn bộ ra hoa: không ổn,

VD : 200X300 - xấu

- Nếu có text khác => sai

VD: ghi chú, các mặt cắt không dung block

 

1./ Xử lý TH viết hoa, viết thường là để tách cái tên dầm ra thôi

Chứ xuất ra kết quả thì chữ nào Hoa ra Hoa , thường ra thường ^_^

 

2./ Text khác thì kiểu nó nhiều kiểu. Nên thống nhất 1 kiểu duy nhất.

Mình khuyến cáo nên sử dụng Block thuộc tính có 2 ATT : 1 là tên cấu kiện. 2 là tiết diện thì sẽ dễ xử lý hơn


  • 0

#9 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 07 September 2016 - 09:25 AM

Tôi không dùng lisp này nhưng khi test :

200X300 là kết quả khi chạy lisp tkt

Trong kết cấu, tên ck nếu viết đầy đủ: Dầm 1, Cột 1 ...(ít xảy ra) => sai

nhưng nếu viết tắt thì cấu kiện ĐK => sai

Tóm lại: hàm vl-string-left-trim không ổn

 

@ptd1987: text nào sai mẫu thì ghi ra hay post file


  • 0

#10 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 07 September 2016 - 11:03 AM

Yêu cầu, tiết diện dầm luôn để trong (), tên dầm viết hoa, viết thường, độ dài tùy ý (Trong Text có duy nhất 1 cặp dấu "()").

(defun sub_str  (str ch1 ch2 / pos tendam kthuoc)
  (if (and (setq pos (vl-string-search ch1 str)) (vl-string-search ch2 str))
   (setq tendam (substr str 1 pos)
         kthuoc (vl-string-trim ch2 (substr str (+ 2 pos))))
   (setq tendam "???"
         kthuoc "xxx"))
  (list tendam kthuoc))

VD: (sub_str "Dam-01A(220x300)" "(" ")")


  • 1

#11 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 07 September 2016 - 11:51 AM

Tôi thì dùng acet: bỏ qua phần tử thứ 3

(acet-str-to-list "("  (vl-string-subst "(" ")" "Dam-01A(220x300)"))


  • 1

#12 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 07 September 2016 - 12:22 PM

1./ Xử lý TH viết hoa, viết thường là để tách cái tên dầm ra thôi

Chứ xuất ra kết quả thì chữ nào Hoa ra Hoa , thường ra thường ^_^

 

2./ Text khác thì kiểu nó nhiều kiểu. Nên thống nhất 1 kiểu duy nhất.

Mình khuyến cáo nên sử dụng Block thuộc tính có 2 ATT : 1 là tên cấu kiện. 2 là tiết diện thì sẽ dễ xử lý hơn

1/ KQ 200X300 vẫn bị viết HOA dù text là viết thường bác Tue ơi, cột SL chắc bác không để ý, vẫn là "1" chứ không phải là "01"

2/ Em tưởng xử lý text đơn giản hơn ATT chứ không em em nhờ bác làm theo mẫu ATT sau chắc khoẻ hơn rồi

http://www.mediafire.com/?wzomwnidntv

3/ Em mới tự học tới hàm CAR CDR thấy các bác viết mấy hàm gì gì hoa cả mắt :ph34r: :wacko:


  • 0

#13 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 07 September 2016 - 04:32 PM

Bạn thử lisp này xem (AttBlock): http://www.cadviet.c..._tkckattblk.lsp
(defun c:tt (/ stt-sl-int acdoc blname ent i itl ktd lst mspace pt ss str tck tenbve)
(defun stt-sl-int (num)
(if (> num 9)
(setq str (itoa num))
(setq str (strcat (chr 48) (itoa num))))
str)
;; *** MAIN ***
(vl-load-com)
(or #sohienbanve# (setq #sohienbanve# 1))
(if (and (setq ss (getblockselection "CK"))
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
mspace (vla-get-modelspace acdoc)
blname "TKCK"
tenbve "KC-"
i -1)
(setq #sohienbanve# (cond ((getint (strcat "\nSo hieu ban ve <" tenbve (stt-sl-int #sohienbanve#) ">: ")))
(#sohienbanve#)))
(setq pt (getpoint "\nDiem chen bang: ")))
(progn (while (setq ent (ssname ss (setq i (1+ i))))
(setq itl (LM:vl-getattributes (vlax-ename->vla-object ent))
tck (cdr (car itl))
ktd (cdr (cadr itl)))
(if (not (assoc (list tck ktd) lst))
(setq lst (cons (cons (list tck ktd) 1) lst))
(setq lst (subst (cons (list tck ktd) (1+ (cdr (assoc (list tck ktd) lst)))) (assoc (list tck ktd) lst) lst))))
(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point pt) blname 1 1 1 0)
(mapcar '(lambda (a B) (cons a B))
'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")
(list "STT" "TÊN CK" "KÍCH TH\U+01AF\U+1EDAC" "S\U+1ED0 L\U+01AF\U+1EE2NG" "CHI TI\U+1EBET XEM B\U+1EA2N V\U+1EBC")))
(setq i 0)
(foreach x (vl-sort lst '(lambda (x y) (< (caar x) (caar y))))
(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point (polar pt (* 1.5 pi) (* 600 (1+ i)))) blname 1 1 1 0)
(mapcar '(lambda (a B) (cons a B))
'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")
(list (stt-sl-int (setq i (1+ i)))
(caar x)
(cadar x)
(stt-sl-int (cdr x))
(strcat tenbve (stt-sl-int #sohienbanve#))))))))
(princ))
;;-----------------------------------------------------------
(defun LM:getanonymousreferences (blk / ano def lst rec ref)
(setq blk (strcase blk))
(while (setq def (tblnext "block" (null def)))
(if (and (= 1 (logand 1 (cdr (assoc 70 def))))
(setq rec (entget (cdr (assoc 330 (entget (tblobjname "block" (setq ano (cdr (assoc 2 def))))))))))
(while (and (not (member ano lst)) (setq ref (assoc 331 rec)))
(if (and (entget (cdr ref)) (wcmatch (strcase (LM:al-effectivename (cdr ref))) blk))
(setq lst (cons ano lst)))
(setq rec (cdr (member (assoc 331 rec) rec))))))
(reverse lst))
(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:vl-getattributes (blk)
(mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)))
(defun LM:vl-setattributevalues (blk lst / itm)
(foreach att (vlax-invoke blk 'getattributes)
(if (setq itm (assoc (vla-get-tagstring att) lst))
(vla-put-textstring att (cdr itm)))))
(defun getblockselection (blk)
(ssget
(list '(0 . "INSERT")
'(66 . 1)
(cons 2
(apply 'strcat (cons blk (mapcar '(lambda (x) (strcat ",`" x)) (LM:getanonymousreferences blk))))))))

P/s:
- Số hiệu bản vẽ chỉ cần nhập số.
- Phần KC- bạn có thể thay trong lisp.
  • 1

#14 ptd1987

ptd1987

    biết vẽ ellipse

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

Đã gửi 07 September 2016 - 05:15 PM

Perfect lisp !!!!

Thanks bác quocmanh04tt thế nào cho đủ bây giờ :wub: :wub:


  • 0

#15 vanhaks

vanhaks

    Chưa sử dụng CAD

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

Đã gửi 02 October 2016 - 08:36 AM

Bạn thử lisp này xem (AttBlock): http://www.cadviet.c..._tkckattblk.lsp

(defun c:tt (/ stt-sl-int acdoc blname ent i itl ktd lst mspace pt ss str tck tenbve)
(defun stt-sl-int (num)
(if (> num 9)
(setq str (itoa num))
(setq str (strcat (chr 48) (itoa num))))
str)
;; *** MAIN ***
(vl-load-com)
(or #sohienbanve# (setq #sohienbanve# 1))
(if (and (setq ss (getblockselection "CK"))
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
mspace (vla-get-modelspace acdoc)
blname "TKCK"
tenbve "KC-"
i -1)
(setq #sohienbanve# (cond ((getint (strcat "\nSo hieu ban ve <" tenbve (stt-sl-int #sohienbanve#) ">: ")))
(#sohienbanve#)))
(setq pt (getpoint "\nDiem chen bang: ")))
(progn (while (setq ent (ssname ss (setq i (1+ i))))
(setq itl (LM:vl-getattributes (vlax-ename->vla-object ent))
tck (cdr (car itl))
ktd (cdr (cadr itl)))
(if (not (assoc (list tck ktd) lst))
(setq lst (cons (cons (list tck ktd) 1) lst))
(setq lst (subst (cons (list tck ktd) (1+ (cdr (assoc (list tck ktd) lst)))) (assoc (list tck ktd) lst) lst))))
(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point pt) blname 1 1 1 0)
(mapcar '(lambda (a B) (cons a B))
'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")
(list "STT" "TÊN CK" "KÍCH TH\U+01AF\U+1EDAC" "S\U+1ED0 L\U+01AF\U+1EE2NG" "CHI TI\U+1EBET XEM B\U+1EA2N V\U+1EBC")))
(setq i 0)
(foreach x (vl-sort lst '(lambda (x y) (< (caar x) (caar y))))
(LM:vl-setattributevalues (vla-InsertBlock mspace (vlax-3d-point (polar pt (* 1.5 pi) (* 600 (1+ i)))) blname 1 1 1 0)
(mapcar '(lambda (a B) (cons a B))
'("STT" "TEN_CK" "KICH_THUOC" "SO_LUONG" "CHI_TIET_XEM_BAN_VE")
(list (stt-sl-int (setq i (1+ i)))
(caar x)
(cadar x)
(stt-sl-int (cdr x))
(strcat tenbve (stt-sl-int #sohienbanve#))))))))
(princ))
;;-----------------------------------------------------------
(defun LM:getanonymousreferences (blk / ano def lst rec ref)
(setq blk (strcase blk))
(while (setq def (tblnext "block" (null def)))
(if (and (= 1 (logand 1 (cdr (assoc 70 def))))
(setq rec (entget (cdr (assoc 330 (entget (tblobjname "block" (setq ano (cdr (assoc 2 def))))))))))
(while (and (not (member ano lst)) (setq ref (assoc 331 rec)))
(if (and (entget (cdr ref)) (wcmatch (strcase (LM:al-effectivename (cdr ref))) blk))
(setq lst (cons ano lst)))
(setq rec (cdr (member (assoc 331 rec) rec))))))
(reverse lst))
(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:vl-getattributes (blk)
(mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)))
(defun LM:vl-setattributevalues (blk lst / itm)
(foreach att (vlax-invoke blk 'getattributes)
(if (setq itm (assoc (vla-get-tagstring att) lst))
(vla-put-textstring att (cdr itm)))))
(defun getblockselection (blk)
(ssget
(list '(0 . "INSERT")
'(66 . 1)
(cons 2
(apply 'strcat (cons blk (mapcar '(lambda (x) (strcat ",`" x)) (LM:getanonymousreferences blk))))))))

P/s:
- Số hiệu bản vẽ chỉ cần nhập số.
- Phần KC- bạn có thể thay trong lisp.

Anh @quocmanh04tt ơi. Em tải về và tạo BLOCK có tên "CK" với 2 attribute (1 ATT dành cho tên cấu kiện, 1 ATT cho kích thước) nhưng khi chọn điểm chèn bảng thì nó báo lỗi Automation Error. Filer error. Em không biết cần hiệu chỉnh gì thêm trong lisp nữa không. :( Em không rành về lisp cho lắm. Em gửi anh file cad. https://drive.google...WVkOU9OUFU/view


  • 0

#16 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 05 October 2016 - 04:59 PM

@vanhaks

Lisp theo yêu cầu, do vậy file của bạn thiếu 1 block (là block bảng thống kê). Block này có tên là "TKCK", có 5 TagName bao gồm:

"STT"

"TEN_CK"

"KICH_THUOC"

"SO_LUONG"

"CHI_TIET_XEM_BAN_VE"


  • 1