Chuyển đến nội dung
Diễn đàn CADViet
hotanphi

Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

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

Xin chào cả nhà.

Do yêu cầu công việc em phải ghi dimention sau đó nhập thủ công vào text có sẵn qunheieuf đối tượng rất tốn thời gian và dễ nhầm lẫn. Em nhờ các anh chị em trên diễn đàn viết hộ em cái lisp với nội dung như sau:

Lisp đo khoảng cách 2 điểm bất kỳ sau đó thay thế giá trị vào text có sẵn trên bản vẽ bằng cách nhấp vào text đó. Sau khi thay đổi giá trị thì text đó sẽ đổi màu mà không thay đổi các yếu tố khác như số lẻ sau dấu phảy, cao text, text style.....

Em có thể diễn đạt sơ bộ như sau:

Nhập lệnh: TT

Nhấp điểm thứ nhất: pick chuột vào điểm cần chọn.

Nhấp điểm thứ 2: pick chuột vào điểm thứ 2.

Nhấp vào text có sẵn cần thay đổi giá trị. (khi đó giá trị thay đổi sẽ là khoảng cách từ điểm pick chuột thứ nhất đến điểm pick chuột thứ 2)

Hoàn tất.

Em xin cảm ơn cả nhà. Rất mong cả nhà giúp đỡ.

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

Xin chào cả nhà.

Do yêu cầu công việc em phải ghi dimention sau đó nhập thủ công vào text có sẵn qunheieuf đối tượng rất tốn thời gian và dễ nhầm lẫn. Em nhờ các anh chị em trên diễn đàn viết hộ em cái lisp với nội dung như sau:

Lisp đo khoảng cách 2 điểm bất kỳ sau đó thay thế giá trị vào text có sẵn trên bản vẽ bằng cách nhấp vào text đó. Sau khi thay đổi giá trị thì text đó sẽ đổi màu mà không thay đổi các yếu tố khác như số lẻ sau dấu phảy, cao text, text style.....

Em có thể diễn đạt sơ bộ như sau:

Nhập lệnh: TT

Nhấp điểm thứ nhất: pick chuột vào điểm cần chọn.

Nhấp điểm thứ 2: pick chuột vào điểm thứ 2.

Nhấp vào text có sẵn cần thay đổi giá trị. (khi đó giá trị thay đổi sẽ là khoảng cách từ điểm pick chuột thứ nhất đến điểm pick chuột thứ 2)

Hoàn tất.

Em xin cảm ơn cả nhà. Rất mong cả nhà giúp đỡ.

Hề hề hề,

Có phải cái nè không hè???

http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

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

Hề hề hề,

Có phải cái nè không hè???

http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình


(defun c:gt (/ p1 p2 txt etxt d)

(setq p1 (getpoint "\n Chon diem thu nhat")

          p2 (getpoint "\n Chon diem thu hai ")

          txt (car (entsel "\n Chon text can thay" ))

          d (distance p1 p2)

         etxt (entget txt)

         etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)

)

(entmod etxt)

(princ)

)

Có khi ý chủ thớt lại thế này bác ạ. E sửa luôn trên Code bác nhé.


(defun c:gt (/ p1 p2 txt etxt d str)

(setvar "cmdecho" 0)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))

(setq p2 (getpoint p1 "\n Chon diem thu hai "))

(setq txt (car (entsel "\n Chon text can thay" ))))

(progn

(command "undo" "begin")

(setq d (distance p1 p2) etxt (entget txt))

(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))

(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))

(command "undo" "end")

(princ str)

(princ)

)

)

(setvar "cmdecho" 1)

(princ)

)

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

Hề hề hề,

Có phải cái nè không hè???

http://www.cadviet.com/upfiles/3/5194_ghikc.lsp

Code của bác Bình


(defun c:gt (/ p1 p2 txt etxt d)

(setq p1 (getpoint "\n Chon diem thu nhat")

          p2 (getpoint "\n Chon diem thu hai ")

          txt (car (entsel "\n Chon text can thay" ))

          d (distance p1 p2)

         etxt (entget txt)

         etxt (subst (cons 1 (rtos d 2 2)) (assoc 1 etxt) etxt)

)

(entmod etxt)

(princ)

)

Có khi ý chủ thớt lại thế này bác ạ. E sửa luôn trên Code bác nhé.


(defun c:gt (/ p1 p2 txt etxt d str)

(setvar "cmdecho" 0)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))

(setq p2 (getpoint p1 "\n Chon diem thu hai "))

(setq txt (car (entsel "\n Chon text can thay" ))))

(progn

(command "undo" "begin")

(setq d (distance p1 p2) etxt (entget txt))

(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))

(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))

(command "undo" "end")

(princ str)

(princ)

)

)

(setvar "cmdecho" 1)

(princ)

)

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

Dạ em xin cảm ơn anh phamthanhbinh và  anh quansla đã giúp đỡ

Cái lisp của anh Bình đúng như ý em mong muốn. Mong anh giúp thêm đoạn code để sau khi chọn text thay giá trị thì text đó sẽ đổi sang màu đỏ giúp em. Như vậy dễ quản lý hơn và đỡ sót.

Mong các anh giúp cho.

Xin trân trọng cảm ơn

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

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq txt (car (entsel "\n Chon text can thay" ))))
(progn
(command "undo" "begin")
(setq d (distance p1 p2) etxt (entget txt))
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "change" txt "" "p" "c" 1 "")
(command "undo" "end")
(princ str)
(princ)
)
)
(setvar "cmdecho" 1)
(princ)
)

bạn thử xem đứng ý bạn không

  • Vote tăng 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

(defun c:gt (/ p1 p2 txt etxt d str)

(setvar "cmdecho" 0)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))

(setq p2 (getpoint p1 "\n Chon diem thu hai "))

(setq txt (car (entsel "\n Chon text can thay" ))))

(progn

(command "undo" "begin")

(setq d (distance p1 p2) etxt (entget txt))

(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))

(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))

(command "change" txt "" "p" "c" 1 "")

(command "undo" "end")

(princ str)

(princ)

)

)

(setvar "cmdecho" 1)

(princ)

)

bạn thử xem đứng ý bạn không

Chỉnh sao cho nó làm trong số thì sửa thông số nào bác nhỉ, em ko dùng hàng thập phân :(

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

Dạ em xin cảm ơn anh phamthanhbinh và  anh quansla đã giúp đỡ

Cái lisp của anh Bình đúng như ý em mong muốn. Mong anh giúp thêm đoạn code để sau khi chọn text thay giá trị thì text đó sẽ đổi sang màu đỏ giúp em. Như vậy dễ quản lý hơn và đỡ sót.

Mong các anh giúp cho.

Xin trân trọng cảm ơn

Hề hề hề,

Bạn thêm dòng code:

(command "change" txt "" "p" "c" 1 "") vào ngay phía dưới dòng code (entmod etxt)

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

Hề hề hề,

Bạn thêm dòng code:

(command "change" txt "" "p" "c" 1 "") vào ngay phía dưới dòng code (entmod etxt)

Dạ em xin cảm ơn anh và mọi người đã giúp đỡ. Chúc cả nhà sức khỏe và thành công

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

(defun c:gt (/ p1 p2 txt etxt d str)
(setvar "cmdecho" 0)
(command "undo" "begin")
(while (and (setq p1 (getpoint "\n Chon diem thu nhat"))
(setq p2 (getpoint p1 "\n Chon diem thu hai "))
(setq d (distance p1 p2))
(setq tchon (strcase (getstring "\nTuy chon hien thi: Gan gia tri vao text (S), Ghi text (G)")))
(cond
((= tchon "S")
(setq txt (car (entsel "\n Chon text can thay" )))
(setq etxt (entget txt))
(progn
(setq str (strcat "\n" (cdr(assoc 1 etxt)) " + " (rtos d 2 2) " = " (rtos (+ d (atof(cdr(assoc 1 etxt)))) 2 2)))
(entmod(subst(cons 1 (rtos (+ d (atof (cdr(assoc 1 etxt)))) 2 2)) (assoc 1 etxt) etxt))
(command "change" txt "" "p" "c" 1 "")
(princ str)
(princ)
)
)
((= tchon "G")
(setq ddtext (getpoint "\nDiem dat text:"))
(setq gocxoay (angle p1 p2))
(command ".text" "BL" ddtext "" gocxoay (rtos d 2 2))
)
)
(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)
)
)

Xin bạn viết bổ sung việc chọn đo khoảng cách, ghi ra text tại điểm mình chọn và xoay theo chiều của hướng đo.

Cám ơn

bạn test thử xem nhé

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

nhờ các bạn giúp tôi thì muốn đổi luôn kích thước đã đo được ở dim ra text có sẵn

  • 1 .Pic vào đối tượng dim
  • 2. Pic vào text có sẵn.

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

nhờ các bạn giúp tôi thì muốn đổi luôn kích thước đã đo được ở dim ra text có sẵn

  • 1 .Pic vào đối tượng dim
  • 2. Pic vào text có sẵn và đổi màu luôn

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

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while (setq ss (ssget "+.:E:S" '((0 . "DIMENSION"))))
(if ss
(progn
(setq ename (entget (ssname ss 0)))
(setq txt (rtos (cdr (assoc 42 ename)) 2 0))
(setq edd (car (entsel "\nchon text mun gan:")))
(princ "\n")
(khoi edd (list (cons 1 txt) (cons 62 1)))
)
)
(prompt "chon dim mun  lay kich thuoc:")
)
)
;=============
(defun khoi (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
;;;;;;;

 

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

 

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while (setq ss (ssget "+.:E:S" '((0 . "DIMENSION"))))
(if ss
(progn
(setq ename (entget (ssname ss 0)))
(setq txt (rtos (cdr (assoc 42 ename)) 2 0))
(setq edd (car (entsel "\nchon text mun gan:")))
(princ "\n")
(khoi edd (list (cons 1 txt) (cons 62 1)))
)
)
(prompt "chon dim mun  lay kich thuoc:")
)
)
;=============
(defun khoi (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
;;;;;;;

Hề hề hề,

 Nhóc thử coi lại xem cái (setq lstcu (append lstcu (list x))) sẽ ra cái gì nếu như (assoc 62 lstcu) khác với nil  nhé.

 Trong hàm (cond .......) tại sao vẫn để điều kiện (= (cdr (assoc 0 lstcu)) "*polyline") trong khi cái  (setq edd (car (entsel " chon text mun gan"))) và tại sao lại chỉ có điều kiện (= (cdr (assoc 0 lstcu)) "mtext") mà không có text ?????

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

- hàm con nhoc lấy trong bài tập anh Ket cho ra xài lun ấy mà ^^, hàm tổng quát để thay thế 1 hoặc vài cặp dxf của đối tượng, trong lý thuyết anh Ket ghi entmod có khả ghi đè, nên dù  dxf 62 có hay ko cũng ko sao ^^.

- mtext  với polyline thì nó thêm vô chứ ko đè đc nên xét trường hợp riêng cho 2 thằng đó, còn text thường thì ghi đè đc

- dim edit rùi thì tạm thời nhoc chưa pit xử thế nào ^^, nhoc ít dùng dim nên chỉ pit sơ sơ  ^^

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


×