Xin lisp thông kê đối tượng Text

[emhoccad 9]

Chào các bác,

E cần lisp thống kê danh sách các Text trong bản vẽ thành 1 danh sách như bảng dưới.

 

Ví dụ: N1,N2,N3,vv...

 

 

Cảm ơn các bác^^

thong ke text.dwg

[huunhantvxdts 195]

Vào lúc 17/2/2022 tại 18:32, emhoccad đã nói:

Chào các bác,

E cần lisp thống kê danh sách các Text trong bản vẽ thành 1 danh sách như bảng dưới.

 

Ví dụ: N1,N2,N3,vv...

 

 

Cảm ơn các bác^^

thong ke text.dwg

Gửi bạn!!!!

(defun C:TKTE(/ acdoc acspc lsttthe lsttk nd lstin point point2 p1 p2 pointt cur_lay oldos)
(setq cur_lay (getvar "clayer" ))
(setq oldos (getvar "OSMODE"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "UNDO" "Be")
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
		acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace)))
(prompt "\nChon TEXT thong ke")
(setq lsttthe (ST:SS->List-Vla (ssget '((0 . "TEXT")))))
(setq lsttk nil)
(foreach ent lsttthe
;(setq ent (vlax-ename->vla-object (car (entsel))))
(setq nd (vlax-get-property ent 'TextString))
(setq lsttk (append (list nd) lsttk))
)
(setq lstin (LM:CountItems lsttk))
(setq lstin  (vl-sort lstin '(lambda (x y) (< (car x) (car y)))))
(setq point (getpoint "/nPick diem dat"))
(setq point2 (polar point 0 1.38))
(command "Line" point point2 "")
(foreach ent lstin
(setq p1 (polar point (/ pi -2) 0.36))
(setq p2 (polar point2 (/ pi -2) 0.36))
(command "Line" p1 p2 "")
(command "Line" point p1 "")
(command "Line" point2 p2 "")
(command "Line" (polar point 0 (/ 1.38 2)) (polar p1 0 (/ 1.38 2)) "")
(setq pointt (polar (polar p1 0 0.1247) (/ pi 2) 0.0745))
(vla-addtext acspc (car ent) (vlax-3d-point pointt) 0.18)
(setq pointt (polar pointt 0 0.8305))
(vla-addtext acspc (cdr ent) (vlax-3d-point pointt) 0.18)
(setq point p1)
(setq point2 p2)
)
;;;;;;;;;;;;;;;;;;;;
(command "UNDO" "End")
(setvar "clayer" cur_lay)
(setvar "osmode" oldos)
(setvar "CMDECHO" 1)
(princ)
)
(defun LM:CountItems ( l / c l r x )
    (while l
        (setq x (car l)
              c (length l)
              l (vl-remove x (cdr l))
              r (cons (cons x (- c (length l))) r)
        )
    )
    (reverse r)
)
(defun ST:SS->List-Vla (ss / n e l)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))
)
)

 

[emhoccad 9]

Cảm ơn bác @huunhantvxdts, đúng là thứ mình cần rồi.

[thanhduan2407 272]

Thiếu hàm: ST:SS->List-Vla mà bác vẫn chạy được nhỉ?

[huunhantvxdts 195]

2 giờ trước, thanhduan2407 đã nói:

Thiếu hàm: ST:SS->List-Vla mà bác vẫn chạy được nhỉ?

Chắc là máy có load hàm đó vào trong 1 lisp khác rồi Hehehe

[emhoccad 9]

Vào lúc 19/2/2022 tại 11:25, huunhantvxdts đã nói:

Chắc là máy có load hàm đó vào trong 1 lisp khác rồi Hehehe

 

À cũng ko hẳn vậy, trong quá trình chờ đợi các bác trên này rep. E có search dc trên mạng lisp của anh Lee-Marc có tính năng đáp ứng đúng nhu cầu của em.

 

Một lần nữa cảm ơn các bác.

[huunhantvxdts 195]

12 phút trước, emhoccad đã nói:

 

À cũng ko hẳn vậy, trong quá trình chờ đợi các bác trên này rep. E có search dc trên mạng lisp của anh Lee-Marc có tính năng đáp ứng đúng nhu cầu của em.

 

Một lần nữa cảm ơn các bác.

Cái đó mình đã sửa lại lúc phát hiện thiếu hàm rồi mà