Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
19 replies to this topic

#1 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 12 November 2013 - 04:22 PM

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


  • 0

#2 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 12 November 2013 - 08:48 PM

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.c.../5194_ghikc.lsp


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

#3 quansla

quansla

    biết lệnh xclip

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

Đã gửi 12 November 2013 - 09:53 PM

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.c.../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)
)

  • 0

#4 quansla

quansla

    biết lệnh xclip

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

Đã gửi 12 November 2013 - 09:56 PM

Hề hề hề,
Có phải cái nè không hè???
http://www.cadviet.c.../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)
)

  • 0

#5 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 12 November 2013 - 11:28 PM

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


  • 0

#6 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 13 November 2013 - 04:31 PM

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


  • 0

#7 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 13 November 2013 - 05:20 PM

(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


  • 1

#8 tranpro

tranpro

    biết vẽ arc

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

Đã gửi 13 November 2013 - 09:23 PM

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


  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 13 November 2013 - 09:45 PM

Tìm và thay:

2)

Thành:

0)


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


#10 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 14 November 2013 - 12:43 AM

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)


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

#11 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 14 November 2013 - 07:40 AM

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


  • 0

#12 hotanphi

hotanphi

    biết vẽ polygon

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

Đã gửi 14 November 2013 - 07:53 AM

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


  • 0

#13 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 14 November 2013 - 11:11 AM

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


  • 0

#14 tientracdia

tientracdia

    biết lệnh scale

  • Members
  • PipPipPip
  • 147 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 14 November 2013 - 01:43 PM

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.c...3/114381_gt.dwg


  • 0

#15 cd2k44

cd2k44

    Edu level: li5

  • Members
  • PipPipPipPipPipPipPip
  • 648 Bài viết
Điểm đánh giá: 121 (tàm tạm)

Đã gửi 14 November 2013 - 02:10 PM

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


  • 0

#16 2899nb

2899nb

    biết vẽ line

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

Đã gửi 08 November 2014 - 09:00 AM

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.

  • 0

#17 2899nb

2899nb

    biết vẽ line

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

Đã gửi 08 November 2014 - 09:53 AM

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

  • 0

#18 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 08 November 2014 - 11:03 AM

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

 


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^








#19 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 08 November 2014 - 11:27 AM

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


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

#20 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 08 November 2014 - 12:11 PM

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


  • 0
"...................][)e\/i][_ /\/\@Y CrY....................."

(defun THỔ_DÂN_HỌC_CAD (xxxx) ...) ^_^