cho em xin lisp đếm text

Tháng 5 22, 2015

Lỗi do format file không xuống dòng.

conghoa dùng Lisp cũng có "thâm niên" rồi, ráng vận động 1 chút , đưa code vào VLIDE "nhấn 2 cái enter" là chạy được.

Cảm ơn gia_bach chỉ giáo, nói về "thâm niên" thì conghoa cũng chỉ biết dùng thôi chứ ít khi để ý đến code vì nói thật là khả năng tư duy không "ngon" lắm, cũng cố học code mấy lần ko được nên đành biết thân biết phận chỉ biết dùng thôi :)

Tháng 5 25, 2015

Lỗi do format file không xuống dòng.

conghoa dùng Lisp cũng có "thâm niên" rồi, ráng vận động 1 chút , đưa code vào VLIDE "nhấn 2 cái enter" là chạy được.

Lisp hay quá mà down về làm như bác nói mà không được, mình gà mờ, mong giúp đỡ

Tháng 5 26, 2015

Lisp hay quá mà down về làm như bác nói mà không được, mình gà mờ, mong giúp đỡ

Gạo nấu thành cơm rồi, chỉ việc xới ra chén mà làm không được ???

Mà dùng không được, sao biết là hay ???

Dĩ nhiên không phải bấm ở đâu cũng được. Tham khảo hình

:

Tháng 5 26, 2015

Thanks bác nhiều nhé, hehe, thông cảm, do lần đầu tiên biết lệnh VLIDE!!

Tháng 9 20, 2015

Thanks bác nhiều nhé, hehe, thông cảm, do lần đầu tiên biết lệnh VLIDE!!

Anh ơi, em không biết gì về lisp cả nhưng em cần lisp này lắm anh biết sai chỗ nào không? anh sửa lại gửi cho em xin được không. EM cám ơn anh và mấy bác trong diễn đàn nhiều ah, vì qua diễn đàn giúp ích em rất nhiều. Em Thanks các bác nhiều ah.

Tháng 9 20, 2015

Đúng rồi, 2 dòng bạn phát hiện chưa hoàn chỉnh.

Update :

(defun c:tkt (/ lst msp pt ss str txtsiz)  (vl-load-com)    (if (setq ss (ssget(list (cons 0 "TEXT"))))    (progn      (foreach e (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))	(setq str (vla-get-TextString e))	(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) (< (cdr x) (cdr y))))	    pt (getpoint "\nDiem dat Bang :" )	    txtsiz (* (getvar "dimtxt")(getvar "dimscale"))	    msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))      (foreach e lst	(vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz )	(vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz )	(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))	)      )    (alert "Khong chon duoc Text.")    )  (princ))

Bạn gia_bach có thể sửa sao cho lsp chạy được trong môi trường làm việc model và layout luôn giúp mình với

Lsp này chỉ chạy được trong môi trường làm việc model mà thôi, có những lúc mình cần thống kê bên môi trường làm việc layout. Thanks bạn!

Tháng 9 20, 2015

Thử cái này xem:

(defun c:tkt  (/ lst msp pt ss str txtsiz-0 txtsiz doc)

(vl-load-com)

(if (setq ss (ssget (list (cons 0 "TEXT"))))

(progn (foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(setq str (vla-get-TextString e)

txtsiz-0 (vla-get-height e))

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

(or (setq txtsiz (getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos txtsiz-0 2 2) ">: ")))

(setq txtsiz txtsiz-0))

(setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))

pt (getpoint "\nDiem dat Bang :")

doc (vla-get-ActiveDocument (vlax-get-Acad-Object))

msp (if (zerop (vla-get-activespace doc))

(if (= (vla-get-mspace doc) :vlax-true)

(vla-get-modelspace doc)

(vla-get-paperspace doc))

(vla-get-modelspace doc)))

(foreach e lst

(vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz)

(vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz)

(setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))))

(alert "Khong chon duoc Text."))

(princ))

Tháng 9 20, 2015

Thử cái này xem:
(defun c:tkt  (/ lst msp pt ss str txtsiz-0 txtsiz doc)
(vl-load-com)

(if (setq ss (ssget (list (cons 0 "TEXT"))))

    (progn (foreach e (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

             (setq str      (vla-get-TextString e)

                   txtsiz-0 (vla-get-height e))

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

           (or (setq txtsiz (getreal (strcat "\nChieu cao Text trong bang thong ke <" (rtos txtsiz-0 2 2) ">: ")))

               (setq txtsiz txtsiz-0))

           (setq lst (vl-sort lst '(lambda (x y) (< (cdr x) (cdr y))))

                 pt (getpoint "\nDiem dat Bang :")

                 doc (vla-get-ActiveDocument (vlax-get-Acad-Object))

                 msp (if (zerop (vla-get-activespace doc))

                       (if (= (vla-get-mspace doc) :vlax-true)

                         (vla-get-modelspace doc)

                         (vla-get-paperspace doc))

                       (vla-get-modelspace doc)))

           (foreach e lst

             (vla-addtext msp (cdr e) (vlax-3d-point pt) txtsiz)

             (vla-addtext msp (car e) (vlax-3d-point (polar pt 0 (* 5 txtsiz))) txtsiz)

             (setq pt (polar pt (/ pi -2) (* 1.5 txtsiz)))))

    (alert "Khong chon duoc Text."))

(princ))

Lsp này ok rồi. thanks bạn quocmanh04tt nhiều lắm

Tháng 10 30, 2015

Mình đang dùng lệnh để tính những đối tượng text, mtext có tên trùng nhau nhưng không được.

Mình có khoanh vùng lại đếm.

Nhờ mọi người giúp giùm mình. Mình có đính kèm bản vẽ

Thank nhiều.

Mình ở đà nẵng. Hân hạnh được giao lưu mọi người.http://www.cadviet.com/upfiles/5/147469_dinh_vi_thiet_bi_tang.dwg

Tháng 10 30, 2015

Mình đang dùng lệnh để tính những đối tượng text, mtext có tên trùng nhau nhưng không được.

Mình có khoanh vùng lại đếm.

Nhờ mọi người giúp giùm mình. Mình có đính kèm bản vẽ

Thank nhiều.

Mình ở đà nẵng. Hân hạnh được giao lưu mọi người.http://www.cadviet.com/upfiles/5/147469_dinh_vi_thiet_bi_tang.dwg

Đơn giản thôi mà . Nhưng mình đang tự hỏi 5x3 có bằng 5+5+5 không? :wub: Tại sao? :wub:

Tháng 10 30, 2015

Why ???

Tháng 11 1, 2015

Mình đang dùng lệnh để tính những đối tượng text, mtext có tên trùng nhau nhưng không được.

Mình có khoanh vùng lại đếm.

Nhờ mọi người giúp giùm mình. Mình có đính kèm bản vẽ

Thank nhiều.

Mình ở đà nẵng. Hân hạnh được giao lưu mọi người.http://www.cadviet.com/upfiles/5/147469_dinh_vi_thiet_bi_tang.dwg

Có lẻ bạn chỉ thích xin cho :( ... Haiza...... đúng là bản chất của đa số công chức VN -_-

http://www.cadviet.com/upfiles/5/127397_dinh_vi_thiet_bi_tang.dwg

Tháng 11 2, 2015

Có lẻ bạn chỉ thích xin cho :( ... Haiza...... đúng là bản chất của đa số công chức VN -_-

http://www.cadviet.com/upfiles/5/127397_dinh_vi_thiet_bi_tang.dwg

Có lẻ bạn giỏi trong lĩnh vực này . Nhưng khi nghe bạn nói như zậy, tôi nghĩ bạn không đủ tư cách để nói chuyện với tôi. Tôi không giỏi nên tôi mới hỏi. Còn nếu bạn không giúp thì có cần thiết phải nói như zậy không.

Tháng 9 24, 2016

Mình down về rồi dùng lệnh tkt của bác gia bạch không dùng được,hay tại phiên bản autocad 2014 không dùng được

bạn phải chuyển cad 2014 3d sang autocad classic thì mới dùng được

Tháng 2 8, 2018

Vào lúc 28/6/2012 tại 23:09, phamthanhbinh đã nói:

Hề hề hề

(cons 0 "text") = (cons 0 "*text")

Tuyệt vời, xài được cả Mtex nữa rồi. Dtex, tex và mtex. Mình k biết bấm sửa ntn, đành mở bằng trình Notepate, nên khi lưu lại nó có hình dạng ntn các bạn này. Có cách nào trả về hình của lips nó đáng yêu màu đo đỏ như ban đầu k ạ

Tháng 11 5, 2018

Vào lúc 3/11/2009 tại 11:21, duy782006 đã nói:

Bạn dùng lisp này xem:

-Lệnh: demt

-Thap tác: nhập lệnh enter. Chọn text mẫu, chọn vùng muốn đếm.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;

(Defun c:demt ( )

(prompt "\nChon Text mau.")

(setq DT (car (entsel)))

(setq DT (entget DT))

(setq NDT (cdr (assoc 1 DT)))

(Princ "\nHay chon vung :")

(setq SS (ssget (list (cons 0 "text")

(cons 1 NDT)

)

)

)

(if (Null ss)

(princ "\nKhong tim thay doi tuong nao")

)

(IF (/= NIL SS) (PROGN

(setq Sl (SSLength SS))

(princ (strcat "\nTim thay: <" (itoa sl) "> doi tuong la Text co noi dung: <" NDT ">"))

)

)

(princ)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;

các anh và anh Duy ơi, cái này rất hay, chon đối tượng Text cần đếm và chọn vùng cần đếm. nhưng lệnh khi chon vùng cần đếm ko có tác dụng anh ah, anh sửa lại dùm, chọn vùng nó báo Select objects: 0 found

Mong các anh giúp

Tháng 11 5, 2018

1 phút trước, thanhmicco đã nói:

các anh và anh Duy ơi, cái này rất hay, chon đối tượng Text cần đếm và chọn vùng cần đếm. nhưng lệnh khi chon vùng cần đếm ko có tác dụng anh ah, anh sửa lại dùm, chọn vùng nó báo Select objects: 0 found

Mong các anh giúp

Lisp này chỉ tác dụng với DTEXT thôi không có tác dụng với MTEXT.

Tháng 11 5, 2018

7 phút trước, duy782006 đã nói:

Lisp này chỉ tác dụng với DTEXT thôi không có tác dụng với MTEXT.

vậy anh làm giúp tích hoepj thêm cái Mtext và Text được ko anh, với cái chon vùng bị lỗi hay sao hả anh

Tháng 7 6, 2020

Vào lúc 17/9/2010 tại 08:18, gia_bach đã nói:

Không hiểu ý bạn.

- chức năng cho phép đếm 1 đối tượng : ý bạn là đếm các LINE, ARC, ... ?

Nếu đúng, bạn có thể sử dụng Tools -> Palettes -> Properties để xem.

hoặc tham khảo Lisp Thống kê Block : http://www.cadviet.com/forum/index.php?sho...ost&p=94041

Lisp Thống kê Text trên bản vẽ .

Bổ sung sắp xếp TEXT và tạo bảng (Table)


(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); 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 "Gia tri" 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) 3 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 "Gia tri")
  (vla-setText TblObj 1 2 "So luong")
  (setq i 1 row 2 )
  (foreach e lst
    (vla-setText TblObj row 0 (itoa i))
    (vla-setText TblObj row 1 (car e))
    (vla-setText TblObj row 2 (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)")   )  )

Cảm ơn bạn rất nhiều vì lips rất hay! bạn có thể bổ sung thêm tính năng là thống kê text (mtext) và lập bảng theo thứ tự chọn text phương X (từ trái sang phải) hoặc phương Y (từ trên xuống dưới) thay vì sắp xếp text như hiện nay không?! Chân thành cảm ơn bạn rất nhiều!

Tháng 11 25, 2020

Vào lúc 17/9/2010 tại 08:18, gia_bach đã nói:

Không hiểu ý bạn.

- chức năng cho phép đếm 1 đối tượng : ý bạn là đếm các LINE, ARC, ... ?

Nếu đúng, bạn có thể sử dụng Tools -> Palettes -> Properties để xem.

hoặc tham khảo Lisp Thống kê Block : http://www.cadviet.com/forum/index.php?sho...ost&p=94041

Lisp Thống kê Text trên bản vẽ .

Bổ sung sắp xếp TEXT và tạo bảng (Table)

tkt.lsp
[✎]


(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); 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 "Gia tri" 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) 3 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 "Gia tri")
  (vla-setText TblObj 1 2 "So luong")
  (setq i 1 row 2 )
  (foreach e lst
    (vla-setText TblObj row 0 (itoa i))
    (vla-setText TblObj row 1 (car e))
    (vla-setText TblObj row 2 (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)")   )  )

Vào lúc 17/9/2010 tại 08:18, gia_bach đã nói:

Không hiểu ý bạn.

- chức năng cho phép đếm 1 đối tượng : ý bạn là đếm các LINE, ARC, ... ?

Nếu đúng, bạn có thể sử dụng Tools -> Palettes -> Properties để xem.

hoặc tham khảo Lisp Thống kê Block : http://www.cadviet.com/forum/index.php?sho...ost&p=94041

Lisp Thống kê Text trên bản vẽ .

Bổ sung sắp xếp TEXT và tạo bảng (Table)

tkt.lsp
[✎]


(defun c:tkt(/ ent h height i len0 lst msp pt row ss str str0 str_len tblobj width0 width1); 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 "Gia tri" 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) 3 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 "Gia tri")
  (vla-setText TblObj 1 2 "So luong")
  (setq i 1 row 2 )
  (foreach e lst
    (vla-setText TblObj row 0 (itoa i))
    (vla-setText TblObj row 1 (car e))
    (vla-setText TblObj row 2 (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)")   )  )

hay qua bác. e cảm ơn bác nha

Đăng nhập

cho em xin lisp đếm text

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

conghoa 123

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

pawuta 11

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

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

pawuta 11

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

nguyenthanhtruc 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

Kieu Tan 22

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 634

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

Kieu Tan 22

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

Sky1988 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

pphung183 428

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

pphung183 428

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

pphung183 428

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

Sky1988 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

hoatienii 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

quangteo1482 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

thanhmicco 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

duy782006 1.549

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

thanhmicco 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

mountain84 0

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

Trai Xây Dựng 1