Đến nội dung


Hình ảnh
- - - - -

move text với dấu chấm thập phân


  • Please log in to reply
4 replies to this topic

#1 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 14 August 2007 - 06:25 PM

Trong bản vẽ tôi có những đối tượng text là các số thực, xin các anh trong diễn đàn giúp hộ tiện ích move các text này với định dạng dấu chấm thập phân (không tính đến text height, width factor và có bao nhiêu ký tự đứng bên trái dấu chấm thập phân) về trùng điểm point trước text (font sử dụng là *.shx). File tham khảo
http://www.cadviet.com/upfiles/Move_text.dwg
thanks
  • 0

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 14 August 2007 - 09:24 PM

Trong bản vẽ tôi có những đối tượng text là các số thực, xin các anh trong diễn đàn giúp hộ tiện ích move các text này với định dạng dấu chấm thập phân (không tính đến text height, width factor và có bao nhiêu ký tự đứng bên trái dấu chấm thập phân) về trùng điểm point trước text (font sử dụng là *.shx). File tham khảo
Move_text.dwg
thanks


Lệnh là MTP (move text point).
Chương trình yêu cầu bạn nhập text và point (lẫn lộn). Chương trình sẽ tự động phân loại, những text không có dấu chấm sẽ bị loại bỏ. Với mỗi một text có dấu chấm, chương trình tìm điểm point nào gần với điểm chèn của text nhất để di chuyển dấu chấm đến.


(defun c:MTP ()
(defun 2d(p)
(list (car p) (cadr p))
)
(defun moveone (ent p)
(setq tt (entget ent)
pt (cdr (assoc 10 tt))
gt (cdr (assoc 1 tt))
vt (vl-string-position (ascii ".") gt)
gtn (substr gt 1 (1+ vt))
ttn (subst (cons 1 gtn) (assoc 1 tt) tt)
vuong (textbox ttn)
p1 (car vuong)
p2 (cadr vuong)
dxl (- 0.0 (car p2))
dyl (- 0.0 (cadr p1))
dxt (- (car p) (car pt))
dyt (- (cadr p) (cadr pt))
dxg (+ dxt dxl)
dyg (+ dyt dyl)
xm (+ (car pt) dxg)
ym (+ (cadr pt) dyg)
pm (list xm ym (caddr pt))
tt (subst (cons 10 pm) (cons 10 pt) tt)
)
(entmod tt)
(entupd ent)
)
(princ "\nMove text point © CADViet.com")
(setq ss (ssget '((0 . "POINT,TEXT")))
lstent (ss2ent ss)
lsttext nil
lstpoint nil
)
(foreach pp lstent
(if (= "POINT" (cdr (assoc 0 (entget pp))))
(setq
lstpoint (append lstpoint (list (cdr (assoc 10 (entget pp)))))
)
(if (vl-string-position (ascii ".") (cdr (assoc 1 (entget pp))))
(setq lsttext (append lsttext (list pp)))
)
)
)
(if (or (= (length lsttext) 0)
(= (length lstpoint) 0)
)
(princ "\nBan phai chon ca text co dau cham va point!")
(foreach ppt lsttext
(setq pmin nil
kcmin nil
)
(foreach ppp lstpoint
(setq tmp (distance (2d ppp) (2d (cdr (assoc 10 (entget ppt))))))
(if
(or (not pmin)
(< tmp
kcmin
)
)
(setq pmin ppp
kcmin tmp
)
)
)
(moveone ppt pmin)
)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

(princ "\nMTP - free lisp from www.cadviet.com")
(vl-load-com)

Bài viết đã được chỉnh sửa nội dung bởi Nguyen Hoanh: 03 September 2011 - 01:22 PM
Sửa lỗi text bị nhảy lung tung

  • 1

#3 vbao

vbao

    biết lệnh array

  • CADViet Team
  • PipPipPip
  • 184 Bài viết
Điểm đánh giá: 80 (tàm tạm)

Đã gửi 15 August 2007 - 02:26 PM

Lệnh là MTP (move text point).
Chương trình yêu cầu bạn nhập text và point (lẫn lộn). Chương trình sẽ tự động phân loại, những text không có dấu chấm sẽ bị loại bỏ. Với mỗi một text có dấu chấm, chương trình tìm điểm point nào gần với điểm chèn của text nhất để di chuyển dấu chấm đến.


cảm ơn anh Hoành, anh cho tôi hỏi thêm: chương trình chỉ cho chọn từng cặp đối tượng (text +point) một, nếu chọn nhiều cặp đối tượng tôi gặp lỗi khi move xảy ra tình trạng vị trí text 1 sẽ hoán đổi cho vị trí text 2
  • 0

#4 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 07 August 2008 - 09:31 PM

cảm ơn anh Hoành, anh cho tôi hỏi thêm: chương trình chỉ cho chọn từng cặp đối tượng (text +point) một, nếu chọn nhiều cặp đối tượng tôi gặp lỗi khi move xảy ra tình trạng vị trí text 1 sẽ hoán đổi cho vị trí text 2

Xin lỗi vì đã bỏ quên không đọc bài này của bác Vbao.
Mọi người hãy download lại bài viết đã chỉnh sửa phía trên của tôi.
  • 1

#5 meohoang

meohoang

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 811 Bài viết
Điểm đánh giá: 342 (khá)

Đã gửi 07 August 2008 - 10:24 PM

Xin lỗi vì đã bỏ quên không đọc bài này của bác Vbao.
Mọi người hãy download lại bài viết đã chỉnh sửa phía trên của tôi.

Rất cám ơn bạn đã chỉnh lại MTP . Mr. Hoành số dzách à nghen!
  • 0