Đến nội dung


Hình ảnh
- - - - -

cho em xin lisp đếm text


  • Please log in to reply
38 replies to this topic

#1 thimathi

thimathi

    Chưa sử dụng CAD

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

Đã gửi 03 November 2009 - 09:29 AM

làm cách nào để bít có bao nhiêu đoạn text giống nhau , " dùng để thống kê " :D ai bít code hay lisp thi giúp em với thank :tongue2:
  • 0

#2 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 03 November 2009 - 11:21 AM

làm cách nào để bít có bao nhiêu đoạn text giống nhau , " dùng để thống kê " :D ai bít code hay lisp thi giúp em với thank :tongue2:

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

  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#3 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 03 November 2009 - 12:53 PM

làm cách nào để bít có bao nhiêu đoạn text giống nhau , " dùng để thống kê " :D ai bít code hay lisp thi giúp em với thank :tongue2:

Bạn dùng thử Lisp thống kê Text trên bản vẽ
kết quả gồm 2 cột :
- cột 1 : số luợng Text
- cột 2 : giá trị Text
(defun c:tkt (/ lst msp pt ss str txtsiz)
(vl-load-com)
(setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) lst (list))
(prompt (strcat "\nChon Text de Liet ke hay ENTER de chon tat ca :"))
(if (null (setq ss (ssget(list (cons 0 "TEXT"))))) (setq ss (ssget "_X" (list(cons 410 (getvar "Ctab")) (cons 0 "TEXT")))))
(if ss
(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")))
(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))

  • 0

#4 hdg2318

hdg2318

    biết lệnh mirror

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

Đã gửi 15 September 2010 - 12:18 AM

Bạn dùng thử Lisp thống kê Text trên bản vẽ
kết quả gồm 2 cột :
- cột 1 : số luợng Text
- cột 2 : giá trị Text

(defun c:tkt (/ lst msp pt ss str txtsiz)
(vl-load-com)
(setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) lst (list))
(prompt (strcat "\nChon Text de Liet ke hay ENTER de chon tat ca :"))
(if (null (setq ss (ssget(list (cons 0 "TEXT"))))) (setq ss (ssget "_X" (list(cons 410 (getvar "Ctab")) (cons 0 "TEXT")))))
(if ss
(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")))
(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 giabach xem lại lisp dùm mình với, nghe giới thiệu thấy có vẻ rất hay và đáp ứng được yêu cầu, nhưng mình tải về, ko chạy được, có lẽ là lỗi ở 2 dòng lệnh điều kiện

(if (null (setq ss (ssget(list (cons 0 "TEXT"))))) (setq ss (ssget "_X" (list(cons 410 (getvar "Ctab")) (cons 0 "TEXT")))))
(if ss


mình mới ngâm cứu cái món này nên chưa biết chỉnh lại thế nào cả :undecided:
  • 0

Có 2 cách để nhìn đời:
1 là : coi như chẳng có gì là huyền diệu
2 là : coi như mọi điều đều huyền diệu


Click here


#5 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 15 September 2010 - 07:29 AM

bạn giabach xem lại lisp dùm mình với, nghe giới thiệu thấy có vẻ rất hay và đáp ứng được yêu cầu, nhưng mình tải về, ko chạy được, có lẽ là lỗi ở 2 dòng lệnh điều kiện

(if (null (setq ss (ssget(list (cons 0 "TEXT"))))) (setq ss (ssget "_X" (list(cons 410 (getvar "Ctab")) (cons 0 "TEXT")))))
(if ss


mình mới ngâm cứu cái món này nên chưa biết chỉnh lại thế nào cả :undecided:

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

  • 4

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 15 September 2010 - 06:21 PM

Lisp này mà có chế độ sắp xếp text,tùy chỉnh textstyle theo 1 text,và kẻ bảng xung quanh thì tuyệt vời ^^..Tks a gia_bach ^^
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 hdg2318

hdg2318

    biết lệnh mirror

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

Đã gửi 15 September 2010 - 06:31 PM

ok, đã chạy tít. Thanks! :bigsmile: :undecided:
  • 0

Có 2 cách để nhìn đời:
1 là : coi như chẳng có gì là huyền diệu
2 là : coi như mọi điều đều huyền diệu


Click here


#8 790312

790312

    biết lệnh fillet

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

Đã gửi 16 September 2010 - 08:50 AM

Lisp của bạn gia bạch rất hay,nhưng bạn có thể thêm chức năng cho phép đếm 1 đối tượng như chọn 1 đối tượng rồi chọn vùng sẽ đếm có bao nhiêu đối tượng đã chọn.Thanks
  • 0

#9 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 17 September 2010 - 08:18 AM

Lisp của bạn gia bạch rất hay,nhưng bạn có thể thêm chức năng cho phép đếm 1 đối tượng như chọn 1 đối tượng rồi chọn vùng sẽ đếm có bao nhiêu đối tượng đã chọn.Thanks

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.c...o...ost&p=94041

Lisp này mà có chế độ sắp xếp text,tùy chỉnh textstyle theo 1 text,và kẻ bảng xung quanh thì tuyệt vời ^^..Tks a gia_bach ^^

Lisp Thống kê Text trên bản vẽ .
Bổ sung sắp xếp TEXT và tạo bảng (Table)
Hình đã gửi
(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)") ) )

  • 3

#10 790312

790312

    biết lệnh fillet

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

Đã gửi 17 September 2010 - 08:30 AM

Ý mình là có chức năng đếm giống lisp của DUY782006 đó.Thanks
  • 0

#11 vinhhien

vinhhien

    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 March 2012 - 02:03 PM

Bác gia_bach ơi cho e hỏi, sau cái lisp này không thể đếm được Mtext và text vậy bác, nó chỉ đếm được Dtext thui a. Bác chó thể sửa lại cho nó đếm hết luôn mấy loại text kia không.
  • 0

#12 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 02 March 2012 - 03:09 PM

Bác gia_bach ơi cho e hỏi, sau cái lisp này không thể đếm được Mtext và text vậy bác, nó chỉ đếm được Dtext thui a. Bác chó thể sửa lại cho nó đếm hết luôn mấy loại text kia không.

Bạn mở lisp ra, sửa chữ "TEXT" thành "*TEXT" là được.
  • 1

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


#13 SalamanderEF

SalamanderEF

    Chưa sử dụng CAD

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

Đã gửi 12 March 2012 - 09:25 AM

Cho mình hỏi có cách nào chuyển từ bảng đó qua excel được không.
  • 0

#14 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 12 March 2012 - 09:34 AM

Cho mình hỏi có cách nào chuyển từ bảng đó qua excel được không.

Bạn dùng lệnh : tableexport
  • 1

#15 thanhhung12003

thanhhung12003

    biết pan

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

Đã gửi 28 June 2012 - 07:17 PM

Hi Bac Gia-Bach.
lisp chạy rất ok và nhanh, thanks bác nhiều. Nhưng Bác viết để nó thống kê luôn Mtext được không! Vì nhiều khi có Mtext mà nó không thống kê hết nên mình bị xót.
  • 0

#16 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 28 June 2012 - 07:41 PM

Hi Bac Gia-Bach.
lisp chạy rất ok và nhanh, thanks bác nhiều. Nhưng Bác viết để nó thống kê luôn Mtext được không! Vì nhiều khi có Mtext mà nó không thống kê hết nên mình bị xót.

Bạn làm ơn đọc lại từ đầu đến cuối topic
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#17 thanhhung12003

thanhhung12003

    biết pan

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

Đã gửi 28 June 2012 - 08:00 PM

Chào!
Mình đã thay Text = *text mà nó báo lỗi, vì mình không biết về lisp nên thay hết! bác chỉ xem thay text = *text ở đâu thì được.!
  • 0

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2012 - 11:09 PM

Chào!
Mình đã thay Text = *text mà nó báo lỗi, vì mình không biết về lisp nên thay hết! bác chỉ xem thay text = *text ở đâu thì được.!

Hề hề hề
(cons 0 "text") = (cons 0 "*text")
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 thanhhung12003

thanhhung12003

    biết pan

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

Đã gửi 28 June 2012 - 11:25 PM

Thanks bác nhiều, em làm được rùi .... hi hi
  • 0

#20 haminhhuong

haminhhuong

    biết zoom

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

Đã gửi 10 July 2012 - 10:06 AM

hề hề, cảm ơn bác nhiều, công việc thống kê của em đỡ vất vả hơn
  • 0