Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#461 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 04 December 2009 - 03:38 PM

Chào thiep
1. tọa độ điểm chèn text không trùng với tọa độ điểm chèn point
Đây là trường hợp rất thường gặp, khi các bác trắc đạc dời text cao độ vì chúng nó đôi khi hay nằm gần kề nhau (dời ra cho thoáng ấy mà).
-> t/hợp này rất khó xử lý vì khi đó xung quanh điểm chèn point có thể sẽ có 2 Text trở lên. Dựa trên cơ sở nào để quyết định (filter) Text nào là đúng.
Cách khắc phục nói chung là : các bác muốn thoáng thì chờ chạy LISP xong rồi hãy dời text cao độ.

Chào Gia_bach và Tue_NV,
Có 1 hàm tìm gần của bác Hoành rất hay, mà thiep đã sử dụng để nâng cấp lisp JD.lsp nối các điểm đường chuyền, bây giờ không nhớ nó nằm chỗ nào nữa. Đoạn mã như sau:
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p (car pp)))
(if (or (not dmin) (> dmin d))
(setq dmin d
ppluu pp
)
)
)
(cdr ppluu)
)
trong đó:
- lst là list tọa độ các điểm chèn text. Dĩ nhiên cần phải lọc thêm text đó phải nằm trên lớp cao độ và phải là text số (trong bản vẽ của tmntpc là lớp el)
- p là 1 trong những tọa độ các point.
Như vậy, hàm này sẽ xác định được text cao độ nào gần với điểm p nhất. Sau đó dùng text cao độ này gán cho cao độ cho point.
Chúc các bạn thành công, hoàn thiện lisp chạy tốt.
  • 1

#462 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 04 December 2009 - 03:38 PM

Cách khắc phục nói chung là : các bác muốn thoáng thì chờ chạy LISP xong rồi hãy dời text cao độ.

*Trường hợp phải kiu tới lisp để làm cái này thì bản vẽ đã qua nhiều tầng nhiều lớp rồi.
-Các chương trình phục vụ việc vẽ bản vẽ địa hình thì thường sau khi nhập số liệu hoặc nhận tệp số liệu từ máy đo đạc sẽ đưa ra màn hình bằng các đối tượng đặc biệt mà chương trình đó hiểu được và có khả năng chỉnh sửa cao: nghĩa là khi cần thay đổi gì nó cập nhật rất nhanh trên các kiểu đối tượng đó. Khi xuất ra bản vẽ cho mấy anh khác làm thì tùy theo tỉ lệ bản vẽ mà xuất ra các đối tượng cad hiểu được theo kích thước hợp lý lúc này tính linh hoạt sẽ mất đi bản vẽ theo mình gọi là đã chết lần 1 <_< .
-Thường thì các anh kiến trúc là tiếp xúc đầu tiên bản vẽ chết này và khi vẽ trên đó các đối tượng có cao độ z này làm ảnh hưởng đến việc vẽ nên các bác này tìm mọi cách cho nó phẳng lì ra nghĩa là tất cả các đối tượng có z=0 ráo trọi. Bản vẽ chết lần 2. :cheers: .
-Thường những anh quan tâm tới cao độ lại tiếp xúc với bản vẽ đã chết lần 2 này dùng các chương trình chuyên ngành. Mấy anh này nếu gặp bản vẽ chết lần 1 thì còn mần en được chứ chết lần 2 thì:
+Thực chất có chương trình sẽ nhận giá trị nhập vào là text thì mần thường.
+Gặp chương trình đòi giá trị nhập vào là point thì chỉ có dòm và kiu lisp.
*Bản thân mình hơi ớn việc đọc text sau đó sửa z cho point. Vì nếu trong quá trình đọc, chỉnh có sai xót thì có trời mới kiểm tra nổi (hông lẽ kiểm tra lại từng point :D hông khéo lại còn bị bắt đền).
*Tốt nhất nên lưu giữ cái bản vẽ chết lần 1 mà làm. Cực chẳng đã mới kiu lisp mà khi kiu tới thì nhờ viết thêm đoạn tréo ngoe là viết 1 text có giá trị của point sau khi đã chỉnh để có đường mà kiểm tra.
  • 0

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


#463 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 04 December 2009 - 07:34 PM

Cám ơn các bạn rẩt nhiều về sự quan tâm này, có một số ý mình nêu rõ hơn là: trong bản vẽ mẫu, các tên điểm t1, t2,...L8,L9.. đây là các "text chữ", gặp trường hợp tên điểm là 1,2,3... là Các "text số", sợ chương trình "đọc nhầm". Bản vẽ mẫu được tạo ra trên cơ sở nhập khẩu từ file ascii bằng lisp. Mình đang sưu tập một số lisp liên quan đến vẽ đường đồng mức, tạo bản đồ. các point giúp tạo ra lưới tam giác để nội suy bình đồ nhưng vì các point có z=0 nên bề mặt phẳng lì không có đường đồng mức nào được tạo ra cả. Lisp Gia-Bach giải quyết được vấn đề
Đúng như duy782006 sẽ có trường hợp bản vẽ "chết lần 2", tất cả Z đều =0, như vậy vấn đề cần đặt ra thêm là yêu cầu lisp chuyển Z các points về đúng giá trị nội dung của text chứ không phải giá trị thuộc tính Z của text (vì tất cả các Z của text đều bằng 0) , mong các bạn giúp thêm yêu cầu này để giải quyết gọn vấn đề.
Sau khi hoàn thành bộ sưu tập lisp về bản đồ, mình sẽ upload để các bạn làm trắc địa dùng chơi
  • 0

#464 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 04 December 2009 - 09:29 PM

......
vấn đề cần đặt ra thêm là yêu cầu lisp chuyển Z các points về đúng giá trị nội dung của text chứ không phải giá trị thuộc tính Z của text (vì tất cả các Z của text đều bằng 0) , mong các bạn giúp thêm yêu cầu này để giải quyết gọn vấn đề.
......

Chào bạn tnmtpc'
Lisp này Tue_NV đã hoàn thiện lại theo yêu cầu của bạn nè. Thử nhé :

(defun c:MPT(/ ss ss2 i j lis Z Z1 Z2 p p2 pkt ent entp L caoZ lay_point
lay_txt ename ans)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt)))
i 0 j 0 lis (list) Z1 (list) Z2 (list))
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis
(list (list (round (car p) 3) (round (cadr p) 3)) )
)
)
(setq Z1 (append Z1 (list (caddr p))))
(if (setq chu (distof (cdr(assoc 1 entp)) 2))
(setq Z2 (append Z2 (list chu)))
)
(setq i (1+ i))
)
(initget "ZT ZC")
(setq ans (getkword
"\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : "
))
(if (= ans "ZT") (setq Z Z1) (setq Z Z2))
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
(progn
(setq caoZ (nth (- (length lis) (length L)) Z) )
(command "move" ent "" (list 0 0 (caddr p2))
(list 0 0 caoZ)
)
)
)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)


Chào Gia_bach và Tue_NV,
Có 1 hàm tìm gần của bác Hoành rất hay, mà thiep đã sử dụng để nâng cấp lisp JD.lsp nối các điểm đường chuyền, bây giờ không nhớ nó nằm chỗ nào nữa. Đoạn mã như sau:
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p (car pp)))
(if (or (not dmin) (> dmin d))
(setq dmin d
ppluu pp
)
)
)
(cdr ppluu)
)
trong đó:
- lst là list tọa độ các điểm chèn text. Dĩ nhiên cần phải lọc thêm text đó phải nằm trên lớp cao độ và phải là text số (trong bản vẽ của tmntpc là lớp el)
- p là 1 trong những tọa độ các point.
Như vậy, hàm này sẽ xác định được text cao độ nào gần với điểm p nhất. Sau đó dùng text cao độ này gán cho cao độ cho point.
Chúc các bạn thành công, hoàn thiện lisp chạy tốt.

Chào bạn thiep :
Nếu sử dụng hàm TIMGAN của bác Hoành trong trường hợp bài toán này có lẽ rằng không được. Vì như thế sẽ dễ gán nhầm cao độ của TEXT "hàng xóm" cho POINT lắm. :cheers:
Cảm ơn lời chúc của thiep. Thanks
  • 2

#465 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 05 December 2009 - 09:51 AM

Chào bạn tnmtpc'
Lisp này Tue_NV đã hoàn thiện lại theo yêu cầu của bạn nè. Thử nhé :


(defun c:MPT(/ ss ss2 i j lis Z Z1 Z2 p p2 pkt ent entp L caoZ lay_point
lay_txt ename ans)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt)))
i 0 j 0 lis (list) Z1 (list) Z2 (list))
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis
(list (list (round (car p) 3) (round (cadr p) 3)) )
)
)
(setq Z1 (append Z1 (list (caddr p))))
(if (setq chu (distof (cdr(assoc 1 entp)) 2))
(setq Z2 (append Z2 (list chu)))
)
(setq i (1+ i))
)
(initget "ZT ZC")
(setq ans (getkword
"\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : "
))
(if (= ans "ZT") (setq Z Z1) (setq Z Z2))
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
(progn
(setq caoZ (nth (- (length lis) (length L)) Z) )
(command "move" ent "" (list 0 0 (caddr p2))
(list 0 0 caoZ)
)
)
)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

Chào bạn thiep :
Nếu sử dụng hàm TIMGAN của bác Hoành trong trường hợp bài toán này có lẽ rằng không được. Vì như thế sẽ dễ gán nhầm cao độ của TEXT "hàng xóm" cho POINT lắm. :cheers:
Cảm ơn lời chúc của thiep. Thanks

Vấn đề đã được giải quyết, cám ơn Tue_NV và các bạn rất nhiều
  • 0

#466 chandatn

chandatn

    biết pan

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

Đã gửi 05 December 2009 - 10:24 AM

Chào bạn chandatn,
Tất cả các đối tượng trong Cad đều được quản lý bởi các mã DXF của chúng. Để xem các mã DXF của một đối tượng bạn sử dụng hàm (entget(car(entsel))) và chọn đối tượng muốn xem.
Để hiểu được các mã này bạn nên tìm hiểu kỹ trong phần hướng dẫn Help của CAD.
Việc hiểu các mã này không quá khó, chỉ cần bạn lưu tâm thì sau một thời gian ngắn bạn sẽ rõ. Việc thuộc các mã này sẽ giúp bạn thuận lợi hơn khi sử dụng nhưng không nhất thiết phải thuộc đâu bạn ạ. Nó khá nhiều và bạn chỉ cần nhớ vài cái chính hay dùng, còn đâu thì mỗi khi cần dùng bạn có thể mở Help ra để tham khảo lại cũng nhanh thôi.
Bạn có thể tham khảo các bài hướng dẫn lập trình lisp có trên diễn đàn và thực hành dần dần sẽ quen thôi, đừng ngại nếu gặp phải khó khăn. Bất cứ khi nào bạn cần đều có thể post yêu cầu của bạn lên mọi người sẽ hỗ trợ. Tuy nhiên việc bạn hiểu và ứng dụng được lisp vào trong côg việc sẽ giúp bạn làm chủ công việc của mình và chủ động hơn nhiều bạn ạ.
Chúc bạn thành công.


Trước tiên mình cám ơn các bạn đã chỉ gúp. Thực tình mình đọc các mã của cad nhưng không hiểu gì! Mình muốn lọc các block có thuộc tính trong tập hợp các đối tượng được chọn để dùng lệnh "burst" cho nhanh mà không biết mã của nó nên không thực tập nổi. Mong các bạn chỉ bảo thêm! Mình chân thành cám ơn!
  • 0

#467 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 05 December 2009 - 03:16 PM

Trước tiên mình cám ơn các bạn đã chỉ gúp. Thực tình mình đọc các mã của cad nhưng không hiểu gì! Mình muốn lọc các block có thuộc tính trong tập hợp các đối tượng được chọn để dùng lệnh "burst" cho nhanh mà không biết mã của nó nên không thực tập nổi. Mong các bạn chỉ bảo thêm! Mình chân thành cám ơn!

Chào bạn chandatn,
Việc đọc và hiểu được các mã DXF của tất cả các đối tượng trong CAD là một việc khá chua đấy. Bạn cần kiên trì và tìm hiểu dần dần chứ đừng ham biết hết ngay một lúc. Mưa dầm thấm đất bạn ạ.
Về các mã DXF của một block, bạn có thể tham khảo ở đây:
((-1 . ) (0 . "INSERT") (330 . ) (5 . "85F") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "DELAMINATION") (100 . "AcDbBlockReference") (66 . 1) (2 . "Atl17") (10 5237.78 4923.46 0.0) (41 . 20.0) (42 . 20.0) (43 . 20.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

Bạn lưu ý các mã sau:
- mã DXF số 0 là mã chỉ kiểu loại đối tượng trong CAD. Với block thì mã này luôn có giá trị là "INSERT" tức (0 . "INSERT")
- mã DXF số 8 là mã chỉ tên lớp chứa đối tượng trong CAD. Ở đây cái Block của bạn nằm trên lớp "DELAMINATION". tức là (8 . "DELAMINATION")
- mã DXF số 66 là mã chỉ đối tượng có hay không có các thuộc tính đi kèm. Khi mã này bằng 1 thì đối tượng có thuộc tính kèm theo và khi nó bằng 0 hay không có thì đối tượng không có thuộc tính đi kèm bạn ạ. Bạn lưu ý rằng mã 66 này chỉ dùng với các đối tượng có thể mang các thuộc tính thôi bạn nhé.
Trong ví dụ ở trên mã DXF 66 là (66 . 1) có nghĩa cái block này có thuộc tính đi kèm bạn ạ.

Như vậy để lọc các block có chứa thuộc tính trên bản vẽ bạn có thể dùng hàm ssget kết hợp với các danh sách lọc như sau:
(setq ss (ssget "x" '(( 0 . "INSERT") (66 . 1))))
Tập chọn ss sẽ bao gồm tất cả các đối tượng là block chứa thuộc tính trên bản vẽ của bạn. Sau đó bạn muốn mổ muốn thiến thế nào đối với các đối tượng trong tập chọn này là tùy ý bạn.
Chúc bạn thành công.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#468 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 05 December 2009 - 03:42 PM

Chào bạn tnmtpc'
Lisp này Tue_NV đã hoàn thiện lại theo yêu cầu của bạn nè. Thử nhé :


(defun c:MPT(/ ss ss2 i j lis Z Z1 Z2 p p2 pkt ent entp L caoZ lay_point
lay_txt ename ans)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt)))
i 0 j 0 lis (list) Z1 (list) Z2 (list))
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis
(list (list (round (car p) 3) (round (cadr p) 3)) )
)
)
(setq Z1 (append Z1 (list (caddr p))))
(if (setq chu (distof (cdr(assoc 1 entp)) 2))
(setq Z2 (append Z2 (list chu)))
)
(setq i (1+ i))
)
(initget "ZT ZC")
(setq ans (getkword
"\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : "
))
(if (= ans "ZT") (setq Z Z1) (setq Z Z2))
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
(progn
(setq caoZ (nth (- (length lis) (length L)) Z) )
(command "move" ent "" (list 0 0 (caddr p2))
(list 0 0 caoZ)
)
)
)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

Chào bạn thiep :
Nếu sử dụng hàm TIMGAN của bác Hoành trong trường hợp bài toán này có lẽ rằng không được. Vì như thế sẽ dễ gán nhầm cao độ của TEXT "hàng xóm" cho POINT lắm. :cheers:
Cảm ơn lời chúc của thiep. Thanks

Chào Tue_NV, vẫn có thể được, bằng cách trước hết "san bằng" độ cao của tất cả text cao độ và point về mặt phẳng 0.0 Sau đó tạo mã duyệt từng point tìm text cao độ gần nó nhất bằng cách sử dụng hàm timgan. Sau đó nâng cả text độ cao và point lên độ cao của nội dung text số. Sau đó .... OK
Không cần hỏi "\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : " vì chỉ 1 điều kiện ZC là OK rồi.
  • 1

#469 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 December 2009 - 10:18 PM

Chào Tue_NV, vẫn có thể được, bằng cách trước hết "san bằng" độ cao của tất cả text cao độ và point về mặt phẳng 0.0 Sau đó tạo mã duyệt từng point tìm text cao độ gần nó nhất bằng cách sử dụng hàm timgan. Sau đó nâng cả text độ cao và point lên độ cao của nội dung text số. Sau đó .... OK
Không cần hỏi "\n Move Z point ve ZTEXT / Move Zpoint ve Z la chu so cua TEXT : " vì chỉ 1 điều kiện ZC là OK rồi.

Chào thiep
Nếu thiep sử dụng từ "san bằng" thì bài toán trở nên đúng đắn. Còn nếu không sử dụng từ "san bằng" thì point rất dễ nhận cao độ Z là Text của thằng "hàng xóm". Lisp TIMGAN của bác Hoành không thể áp dụng đúng trong trường hợp của bài toán không gian 3D trong trường hợp này. Phải nhờ tới điều kiện "san bằng để giải quyết.
Tuy nhiên, nếu mà "san bằng" như vậy thì không thể Move các point về cao độ của điểm chèn Text được vì cao độ của điểm chèn Text và điểm chèn Point được đưa về mặt phẳng 0.0 rồi

Đây là Lisp mà Tue_NV viết theo ý của thiep :
1. "San bằng" độ cao của tất cả text cao độ và point về mặt phẳng 0.0
2. Sử dụng hàm TIMGAN để tìm Text gần point nhất (vì có thể giữa point và Text có khoảng hở nhất định nào đó)
3. Dựa vào nội dung của Text số : đây là độ cao -> theo ý của thiep : nâng cả text độ cao và point lên độ cao của nội dung text số
Cảm ơn thiep đã gợi ý cho Tue_NV hoàn thành code này. Nếu có gì chưa đúng lắm các bạn có thể góp ý để mình chỉnh sửa lại. Thanks

@ tnmtpc : Theo Tue_NV suy luận thì trước khi sử dụng Lisp mà Tue_NV đã viết thì bạn đã sử dụng cái Lisp di chuyển các text sao cho điểm chèn text trùng các point tương ứng rồi, để cho các point và Text trùng nhau rồi, phải không bạn tnmtpc? -> Cái Lisp đó cũng chính là bản chất của Lisp TIMGAN đấy.

Đây là code mà Tue_NV đã viết lại theo ý kiến của bạn thiep

(defun c:MPT(/ ss ss2 i j lis p p2 textgan entextgan Ztextgan ent entp
lay_point lay_txt)
;copyright by Tue_NV
(command "undo" "be")

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon Point de lay Layer chua POINT : ")))
))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ename))))
)

(if (= (cdr (assoc 0 (entget
(setq ename (car (entsel "\nChon TEXT de lay Layer chua TEXT : ")))
))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ename))))
)

(setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 lay_txt)))
i 0 j 0 lis (list) )
(setq ss2 (ssget "X" (list (cons 0 "POINT") (cons 8 lay_Point))) )
(ZO ss) (ZO ss2)

(while (< i (sslength ss))
(setq entp (entget (ssname ss i)) )
(setq p (cdr(assoc 10 entp)))
(setq lis (append lis (list p) )
)

(setq i (1+ i))
)

(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq textgan (ssget "X"
(list
(cons 0 "TEXT")
(cons 8 lay_txt)
(cons 10 (timgan p2 lis))
)))
(setq entextgan (ssname textgan 0))
(if (distof
(cdr(assoc 1 (entget entextgan) )) 2)
(setq Ztextgan
(distof (cdr(assoc 1 (entget entextgan) )) 2)
)
(setq Ztextgan 0.0)
)
(command "move" ent entextgan "" (list 0 0 (caddr p2))
(list 0 0 Ztextgan)
)
(setq j (1+ j))
)
(command "undo" "end")
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)
;
(defun ZO(ss / i ent po)
(setq i 0)
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq po (cdr(assoc 10 ent)))
(entmod (subst (list 10 (car po) (cadr po) 0.0)
(assoc 10 ent) ent
)
)
(setq i (1+ i))
)
)
;
(defun timgan (p lst / dmin ppluu)
(foreach pp lst
(setq d (distance p pp))
(if (or (not dmin) (> dmin d))
(setq dmin d
ppluu pp
)
)
)
ppluu
)

  • 3

#470 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 07 December 2009 - 04:24 PM

mình đang cần gấp 1 lisp như thế này, mong mọi người giúp đỡ.

Trong file bình đồ có nhiều Text (ko có Mtext) , mỗi text ghi cao 1 trình bằng số , vd: 1.34 ; 0.25 ..v....v....
Mình đang cần lisp chuyển các text đó thành số và xuất ra thành 1 cột trong excel để có thể tính tổng và lấy trung bình của các số đó. Có khoảng 3000 text như thế :cheers:
  • 0

#471 dkkx3a

dkkx3a

    biết lệnh trim

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

Đã gửi 07 December 2009 - 05:01 PM

mình đang cần gấp 1 lisp như thế này, mong mọi người giúp đỡ.

Trong file bình đồ có nhiều Text (ko có Mtext) , mỗi text ghi cao 1 trình bằng số , vd: 1.34 ; 0.25 ..v....v....
Mình đang cần lisp chuyển các text đó thành số và xuất ra thành 1 cột trong excel để có thể tính tổng và lấy trung bình của các số đó. Có khoảng 3000 text như thế :cheers:


Bạn dùng thử LISP, nhưng chỉ xuất ra file TXT nhưng bạn cũng có thể mở bằng Excel và lấy giá trị cột Z (cột thứ tư) là cái bạn cần, xin chia sẽ với bạn (mình hay dùng cái này để sài với Nova.............)
;=================================
(DEFUN C:XUATTEXT(/ DIM_OLD THOP SSTHOP INDEX path_file file_write TOLIST VALUE_TEXT CORN_TEXT STT L_POINT STR_KQ )
(alert "DNPP_say: TIEN ICH TRICH XUAT DIEM TEXT.....DUNG IMPORT TRONG NOVA
------------------------------------------------------------------Email: DoanNhut@gmail.com------------------")
(SETQ DIM_OLD (GETVAR "DIMZIN"))
(SETVAR "DIMZIN" 0)
(SETQ THOP (SSGET '((-4 . "")))
SSTHOP (SSLENGTH THOP)
INDEX 0
)

;----------------------------------------------------CHON NOI LUU FILE

(setq path_file (getfiled "DNPP_say: Chon noi luu file Export >>>>>>>>>>>>>>" "DNPP_DATA" "txt" 1))
(setq file_write (open path_file "w"))

;-----------------------------------------------------------------

(WHILE (< INDEX SSTHOP)
;--------------------------------------LAY GIA TRI TEXT
(SETQ TOLIST (ENTGET (SSNAME THOP INDEX))
VALUE_TEXT (CDR (ASSOC 1 TOLIST))
)
;--------------------------------------LAY TOA DO TEXT
(IF (= (CADR (ASSOC 11 TOLIST)) 0)
(SETQ CORN_TEXT (CDR (ASSOC 10 TOLIST)))
(SETQ CORN_TEXT (CDR (ASSOC 11 TOLIST)))
)


;--------------------------------------XULY DATA
(SETQ STT (ITOA (+ 1 INDEX)))
(SETQ L_POINT (LIST (CAR CORN_TEXT) (CADR CORN_TEXT) (ATOF VALUE_TEXT)))
(SETQ STR_KQ
(STRCAT
STT
"\t"
(RTOS (CAR CORN_TEXT) 2 4)
"\t"
(RTOS (CADR CORN_TEXT) 2 4)
"\t"
VALUE_TEXT
)
)
;----------------------------------------LUU FILE
(write-line STR_KQ file_write)
(SETQ INDEX (+ 1 INDEX))
);END WHILE
(close file_write)
(SETVAR "DIMZIN" DIM_OLD)
(PRINC "\n----------0-------- Cong cu xuat TEXT____Created by DoanNhut ----------0--------")
(PRINC)
)
;=======================
Hy vọng bạn dùng được. Hình như diễn đàn có lỗi. Bạn tải cái này:
http://www.cadviet.c...le_xuattext.lsp
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#472 eng-hiep

eng-hiep

    biết lệnh erase

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

Đã gửi 07 December 2009 - 05:08 PM

Em đang cần gấp 1 lisp như thế này, mong mọi người giúp đỡ : Nếu bác nào là dân XD thì đều biết việc đánh tọa độ , tên cọc rất mất công . Vì thế , nếu có 1 lisp dùng để đánh tên cọc và ghi ra tọa độ của cọc (point) đó thì rất tiện dụng . Thx .
  • 0

#473 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 07 December 2009 - 05:34 PM

bạn ơi mình dùng không được, đánh chữ xuattext máy nó báo lỗi

đây là file của mình

http://www.fileden.c...4594/Htrang.dwg

(text màu xanh)

bạn xuất ra được file text thì gửi cho mình luôn nhé :cheers:

Mình chỉ cần tính tổng các text trong đó thôi.
  • 0

#474 dkkx3a

dkkx3a

    biết lệnh trim

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

Đã gửi 07 December 2009 - 06:30 PM

bạn ơi mình dùng không được, đánh chữ xuattext máy nó báo lỗi

đây là file của mình

http://www.fileden.c...4594/Htrang.dwg

(text màu xanh)

bạn xuất ra được file text thì gửi cho mình luôn nhé :cheers:

Mình chỉ cần tính tổng các text trong đó thôi.


LÍP chạy bình thwờng mà, bạn copy đường LINK phía dưới là được, đây là file TXT và XLS mình đã chuyển và đây là cái bạn cần:
http://www.cadviet.c.../2/xuattext.rar
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#475 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 08 December 2009 - 07:34 AM

bạn ơi mình dùng không được, đánh chữ xuattext máy nó báo lỗi

đây là file của mình

http://www.fileden.c...4594/Htrang.dwg

(text màu xanh)

bạn xuất ra được file text thì gửi cho mình luôn nhé :cheers:

Mình chỉ cần tính tổng các text trong đó thôi.

Nếu bạn chỉ cần tính tổng các text (hay cộng, trừ, nhân chia), không cần thiết phải đưa các Text ra file (Text, Excell ...)

Bạn tham khảo List cộng, trừ, nhân chia của q288
http://www.cadviet.c...o...ost&p=65050

hay Lisp cộng trừ nhân chia text, giá trị trung bình cộng các text của q288
http://www.cadviet.c...o...ost&p=65338
  • 0

#476 eng-hiep

eng-hiep

    biết lệnh erase

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

Đã gửi 08 December 2009 - 09:58 AM

Không biết có lisp (hay lệnh) nào có thể chèn 1 ký tự bất kỳ (VD như P , B...) vào 1 số hoặc 1 nhóm số được chọn (sẽ thành P1 ,P2...B1...) không ạ ? Thx :cheers:
  • 0

#477 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 08 December 2009 - 10:26 AM

Không biết có lisp (hay lệnh) nào có thể chèn 1 ký tự bất kỳ (VD như P , B...) vào 1 số hoặc 1 nhóm số được chọn (sẽ thành P1 ,P2...B1...) không ạ ? Thx :cheers:

Coi cái này thử xem:
http://www.cadviet.c...amp;#entry77913

http://www.cadviet.c...o...=6991&st=20
Cập nhật lại . Hoặc bạn vào tìm kiếm gỏ chử themtext
  • 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


#478 eng-hiep

eng-hiep

    biết lệnh erase

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

Đã gửi 08 December 2009 - 10:30 AM

Coi cái này thử xem:
http://www.cadviet.c...amp;#entry77913

Ủa ,có thấy gì đâu bác , chỉ thấy trang chủ của 4rum à ! Bác check lại giúp .Thx
Em đã làm được rồi . Thx bác Duy nhiều !
  • 0

#479 eng-hiep

eng-hiep

    biết lệnh erase

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

Đã gửi 08 December 2009 - 05:27 PM

Em đang cần 1 lisp mà nó có thể xuất ra tọa độ của các point dưới dạng bảng (table) . Bác nào có thì cho em xin với nhé . Thanks a lot !
  • 0

#480 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 09 December 2009 - 09:17 AM

Em đang cần 1 lisp mà nó có thể xuất ra tọa độ của các point dưới dạng bảng (table) . Bác nào có thì cho em xin với nhé . Thanks a lot !

Bạn cung cấp dữ liệu đầu vào đơn giản quá.
Đây là Lisp xuất ra tọa độ của các point dưới dạng bảng (table) ở dạng đơn giản.
(defun c:po(/ coor doc pt siz);point out
(vl-load-com)
(setq doc (vla-get-ActiveDocument(vlax-get-Acad-Object)))
(print "\nChon Point: ")
(if (ssget '((0 . "POINT")))
(progn
(setq pt (getpoint "\nDiem dat Bang :" )
siz (* (getvar "dimtxt")(getvar "dimscale")) )
(vlax-for e (vla-get-ActiveselectionSet doc)
(setq Coor (vl-princ-to-string (vlax-safearray->list (variant-value (vla-get-Coordinates e)))) )
(vla-addtext (vla-get-modelspace doc) Coor (vlax-3d-point pt) siz)
(setq pt (polar pt (/ pi -2) (* 2.0 siz)))
);for
)
)
(princ))

  • 1