Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
emhoccad

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

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

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

 

image.png.c144bf96c964bd47a044c570ee8bbcf5.png

 

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

 

  • Like 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
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

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

  • 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
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à

  • Like 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

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  

×