Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] viết Lisp dời text về vị trí điểm point gần nhất


  • Please log in to reply
56 replies to this topic

#1 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 08:17 AM

Nhờ các cao thủ Lisp viết dùm mình Lisp dời text về vị trí point gần nhất. Lsp tự động đưa các text gần point đó và move trùng lên vị trí point.

Link file minh hoạ:

http://www.mediafire...c viet lisp.dwg


  • 0

#2 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 December 2013 - 08:43 AM

Chào bạn!

 Hiện tại thì điểm canh phải "Right" của Text đã trùng lên point rồi. 

Nếu chuyển điểm canh lề khác của Text trùng lên point thì không cần phải sử dụng Lisp. 

 

- Chọn text (Bằng Quick select hay filter) -> Bấm Ctrol+1 -> Ở Tab Text, mục justify -> Chọn Center là xong


  • 0

#3 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 09:14 AM

Cảm ơn Bác

Tue_NV Bài toán của mình là: khoảng cách các text đến các point không đều nhau. mình muốn Lisp đưa text về trùng voié điểm point ở gần nhất. Còn ở file minh hoạ của mình thì point và Right của text đang có khoảng cách khác nhau và chưa trùng lên point, Bác kiểm tra xem và giúp em với nhé! Thank!
  • 0

#4 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 December 2013 - 09:55 AM

Bạn làm theo các ý mà Tue_NV viết ở trên là được. Chỉnh justify của Text về Center

File của bạn đây: https://www.mediafir...ckzgg7gql62x7sh


  • -1

#5 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 12:47 PM

https://www.mediafir...gzwr34czp8wcweg

Bác TUE_NV vẫn chưa rõ ý của em rồi. bác xem lại file minh hoa này nhé! em muốn dời text vào trùng với tâm của point. file minh hoạ giữa point và text còn cách nhau một khoảng. em đã DIM trong file kèm theo


  • 0

#6 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 01:52 PM

Các Bác bận cả hay sao nhỉ? sao không thấy ai giúp mình với.


  • 0

#7 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 02:14 PM

Bạn thanhduan, ketxu, kangkung, duy đâu nhỉ các bác giúp mình với,


  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 December 2013 - 02:33 PM

Biết tên mọi người - Lập hẳn một nick mới để yêu cầu lisp :)


  • 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


#9 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 12 December 2013 - 02:37 PM

A. hà. Bác ketxu đã xuất hiện. gặp được các bác như nắng hạn gặp mưa, Bác nhiên cứu giúp em với nhé! cám ơn Bác!


  • 0

#10 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 December 2013 - 08:46 PM

Ket đang rất mệt, nên code nhanh cho bạn như vầy thôi, hi vọng bạn dùng đc. Nếu lỗi đâu bạn nhờ các bác khác nhá ^^. Lần sau nếu có yêu CV xin đừng thay tên đổi họ nhiều quá ^^

(defun c:mt2p(/ lst lstData lstT lstP p)
	(and
		(setq ss (ssget (list (cons 0 "TEXT,POINT"))))
		(setq lstData (mapcar 'entget (acet-ss-to-list ss)))
		(foreach e lstData (if (= (cdadr e) "TEXT") (setq lstT (cons e lstT))(setq lstP (cons e lstP))))
	)
	(foreach oT lstT
		(setq p (acet-dxf 11 oT))
		(setq lstP (vl-sort lstP '(lambda(x y)(< (distance (acet-dxf 10 x) p)(distance (acet-dxf 10 y) p)))))
		(entmod (append oT (list (cons 11 (acet-dxf 10 (car lstP))))))
		(setq lstP (cdr lstP))
	)
)

  • 5

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


#11 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 13 December 2013 - 08:22 AM

Ok. Đúng ý của mình rồi. Cảm ơn Bác Ket nhiều nhé! Bác Ket nhiệt tình thật, Cảm ơn bác nhiều!


  • 0

#12 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 13 December 2013 - 11:57 AM

Ok. Đúng ý của mình rồi. Cảm ơn Bác Ket nhiều nhé! Bác Ket nhiệt tình thật, Cảm ơn bác nhiều!

Hề hề hề,

Dựa trên cái lisp của bác Ketxu, mình sửa lại một chút, hy vọng lisp sẽ chạy nhanh hơn khi bản vẽ có nhiều text và point cần hiệu chỉnh.

 

(defun c:movt (/ oldos sslst box polst p)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(setq sslst (mapcar 'entget (acet-ss-to-list (ssget (list (cons 0 "text"))))))
(foreach e sslst
(setq box (acet-ent-geomextents (cdr (assoc -1 e)))
polst (mapcar 'entget (acet-ss-to-list (ssget "c" (car box) (cadr box) (list (cons 0 "point")))))
p (cdr (assoc 11 e))  )
(if polst
 (progn
(setq polst (vl-sort polst '(lambda (x y) (< (distance (cdr (assoc 10 x)) p) (distance (cdr (assoc 10 y)) p))))  )
 (entmod (subst (cons 11 (cdr (assoc 10 (car polst)))) (assoc 11 e) e) )
 )
)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

 

 

 

 

 

 

 

(vl-load-com)
(setq oldos (getvar "osmode"))

  • 6
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#13 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 13 December 2013 - 08:24 PM

Cảm ơn Bác phanthanhbinh Rất nhiều!


  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 December 2013 - 08:30 PM

Vẫn chỉ là ketxu thanks :) Bạn nên ấn Tks vì bác ấy đã viết giúp bạn


  • 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


#15 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 13 December 2013 - 10:00 PM

Bác phanthanhbinh cho em hỏi, muốn tăng giới hạn khoảng cách lên thì sửa dòng nào vậy bác, vì có một số điểm khoảng cách giữa text và point chỉ có 0.5 mét mà lisp không move text đó, nó vẫn giữ nguyên vị trí cũ.


  • 0

#16 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 13 December 2013 - 11:03 PM

Có 1 cách để không "lọt lưới" nếu khoảng cách giữa text và point đủ xa. Đồng thời nó cũng "đủ nhanh".


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


#17 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 14 December 2013 - 10:23 AM

Bác phanthanhbinh cho em hỏi, muốn tăng giới hạn khoảng cách lên thì sửa dòng nào vậy bác, vì có một số điểm khoảng cách giữa text và point chỉ có 0.5 mét mà lisp không move text đó, nó vẫn giữ nguyên vị trí cũ.

Hề hề hề,

Cái ni có lẽ là do cái cách sủ dụng hàm ssget của mình chưa chuẩn rồi. Cần phải check lại.

Mình sử dụng hàm ssget với tham số c nên nò sẽ lựa chọn các point nằm trong hoặc trên hình bao của text. 

Để tăng cái khoảng cách này sẽ phải tăng kích thước cái box lựa chọn lên. Có điều nếu tăng lớn quá sẽ có thể xảy ra trường hợp chọn thừa nhiều điểm làm chậm quá trình chạy lisp.

Bạn thử tăng kích thước cái box này lên 2 lần xem đã ổn chưa nhé,

Thay thế dòng code:

 polst (mapcar 'entget (acet-ss-to-list (ssget "c" (car box) (cadr box) (list (cons 0 "point")))))

bằng dòng code sau:

 polst (mapcar 'entget (acet-ss-to-list (ssget "c" (polar (car box) (* 1.5 pi) (/ (- (cadadr box) (cadar box)) 2)) (polar (cadr box) (* 0.5 pi) (/ (- (cadadr box) (cadar box)) 2)) (list (cons 0 "point")))))

 

Nếu làm như vầy chưa ổn thì bạn tăng tiếp lên thành 3 hay 4 lần. Hy vọng sẽ đạt yêu cầu của bạn. Cách tăng bạn có thể xem kỹ ở dòng code mới thay, kich thước tăng thể hiện ở đoạn code (/ (- (cadadr box) (cadar box)) 2). bạn chỉ cần thay đổi ở đoạn code này là OK.

Chúc bạn thành công.

 

@ Bác DoanVanHa: Nhờ bác chỉ giáo thêm các thuật toán mới.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#18 ANHSURVEY

ANHSURVEY

    biết zoom

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

Đã gửi 19 December 2013 - 09:05 PM

Bác Phanthanhbinh cho em hỏi. em sửa code theo bác rồi mà lisp vânx không cải thiện được vấn đề cũ, mà select nhiều text thì bị lỗi dời text không đúng. nó dờ text đi rất xa điểm gần chúng và chồng lên text khác, mong bác chỉ giáo..


  • 0

#19 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 20 December 2013 - 01:27 AM

Bác Phanthanhbinh cho em hỏi. em sửa code theo bác rồi mà lisp vânx không cải thiện được vấn đề cũ, mà select nhiều text thì bị lỗi dời text không đúng. nó dờ text đi rất xa điểm gần chúng và chồng lên text khác, mong bác chỉ giáo..

Hề hề hề,

Có nhẽ do bản vẽ bạn đang xài hệ tọa độ khác chăng. Hãy thử chuyển hệ tọa độ của bản vẽ về world trước khi chạy líp xem sao nhé.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#20 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 107 (tàm tạm)

Đã gửi 20 December 2013 - 08:17 AM

Bác DoanVanHa: Nhờ bác chỉ giáo thêm các thuật toán mới.

 

Bác DoanVanHa bỏ chút thời gian để viết lisp này cho mọi người tham khảo với ạ. Một bài toán khá tổng quát và thông dụng!


  • 1

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC