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

[hotanphi 0]

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

[phamthanhbinh 3.146]

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

[quansla 259]

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)

)

[quansla 259]

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)

)

[conghoa 123]

Sao không dùng cái lisp ánh xạ text cho tiện nhỉ :)

[hotanphi 0]

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

[cd2k44 123]

(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

[tranpro 2]

(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 :(

[Doan Van Ha 3.191]

Tìm và thay:

2)

Thành:

0)

[phamthanhbinh 3.146]

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)

[tientracdia 16]

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

[hotanphi 0]

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

[cd2k44 123]

(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é

[tientracdia 16]

Chọn vị trí chèn số đo thì ok rồi, nhưng ghi theo chiều hướng đo thì chưa thực hiện được

http://www.cadviet.com/upfiles/3/114381_gt.dwg

[cd2k44 123]

Bạn chuyển đơn vị góc của bản vẽ về đơn vị radians là được mà.

[2899nb 4]

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.

[2899nb 4]

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

[nhoclangbat 392]

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

 

[phamthanhbinh 3.146]

 

- ^^ 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 ?????

[nhoclangbat 392]

- 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ơ  ^^

[843824 1]

Đơn giản mà hay. 

E đang dùng lisp đầu tiên bác Bình up lên.

- Thêm vào dòng code cho đổi màu.

- E cũng nắm sơ sơ nhưng muốn hỏi các bác để học thêm cho dễ xử lý theo ý mình ạ. E có 2 câu hỏi.

 

1. Số tương ứng với màu trong Cad - mình tìm ở đâu (để đổi màu)?

 

2. Như nội dung trên là ok. Nhưng e muốn làm như sau: 

   Text ban đầu: 2.20  .          Sau khi đo ra kết quả 3.36               

   a. Em muốn nó xuất kết quả ra làm tròn thành 3.40       thì mình thêm vào lệnh như thế nào ạ?

   b. Em muốn nó ra kết quả khác định dạng ban đầu:                                  xuất kết quả thành 3.400    hoặc      3.4     thì làm như thế nào.

THANKS!

 

[843824 1]

Vào lúc 20/10/2018 tại 11:10, 843824 đã nói:

Đơn giản mà hay. 

E đang dùng lisp đầu tiên bác Bình up lên.

- Thêm vào dòng code cho đổi màu.

- E cũng nắm sơ sơ nhưng muốn hỏi các bác để học thêm cho dễ xử lý theo ý mình ạ. E có 2 câu hỏi.

 

1. Số tương ứng với màu trong Cad - mình tìm ở đâu (để đổi màu)?

 

2. Như nội dung trên là ok. Nhưng e muốn làm như sau: 

   Text ban đầu: 2.20  .          Sau khi đo ra kết quả 3.36               

   a. Em muốn nó xuất kết quả ra làm tròn thành 3.40       thì mình thêm vào lệnh như thế nào ạ?

   b. Em muốn nó ra kết quả khác định dạng ban đầu:                                  xuất kết quả thành 3.400    hoặc      3.4     thì làm như thế nào.

THANKS!

 

 

- Dạ sr các bác cho e xin bổ sung thêm câu hỏi. Do trong quá trình sử dụng e có gặp thêm trường hợp.

- Đó là khi dùng Lisp trên - khi người dùng pick chọn text nhận kết quả. Khi click ko trúng text thì tự thoát lệnh. 

===> e cần nhờ các bác thêm vào: người dùng phải chọn trúng text nhận kết quả (nếu ko sẽ ko thoát lệnh) - tức phải có đầu ra mới dừng.

[kaykis 2]

Vào lúc 8/11/2014 tại 11:27, phamthanhbinh đã nói:

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

nhờ các anh giúp em 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 

3. Là đúng tỷ lệ chứ kg phải ty lệ 1000 ( cdt ) rồi mấy tỷ lệ kia bị sai hết