Đến nội dung


Hình ảnh
- - - - -

[Nhờ Chỉnh Sửa] Đo khoảng cách hai điểm và ghi kết quả ra nơi minh chọn


  • Please log in to reply
49 replies to this topic

#1 vantuan18nd

vantuan18nd

    biết vẽ rectang

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

Đã gửi 26 December 2011 - 02:22 PM

Mình có nhờ Anh Vo Quang Tue ( hay Võ Quang Tuệ gì gì đấy :mellow: ) làm cho Lisp đo khoảng cách rất hay như sau
-chọn điểm thứ nhất
-chọn điểm thứ hai
-Kết quả thay cho một số có sẵn

(defun C:TL3( / ss L te p1 p2)

(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))


(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)



-> Enter để kết thúc lệnh

- Bây giờ mình muốn kết quả tìm được phải ghi ra nơi mình chọn, không phải là thay cho một số có sẵn như trước.

Nhờ mọi người sửa giúp.
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 26 December 2011 - 02:41 PM

Bạn đã đọc nội quy, vậy hãy cố cho code vào thẻ code nhé. Lần đầu này mình sửa hộ bạn

(defun c:tl3 (/) (vl-load-com)
(vla-addtext
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(rtos (getdist (getpoint "\nP1 :") "\nP2 :") 2 2)
(vlax-3d-point (getpoint "\nDiem dat KQ :"))
(* (getvar "dimtxt")(getvar "dimscale"))
)
(princ))

  • 2

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


#3 Chiron

Chiron

    biết dimradius

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

Đã gửi 26 December 2011 - 02:41 PM

Mình đang tập tành mót LISP. Mặc định, mình đo theo mét, nếu không thích thì mình sẽ bỏ đi đơn vị. Hi vọng cái này đúng ý bạn:

(defun C:TL3 (/ L p1 p2 txtht pnt)
(while
(and
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
;;; (setq te (entget (car (entsel"\n Chon Text de gan ket qua :")))
;;; te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
;;; (entmod te)
(setq pnt (getpoint "\nChon diem chen text:"))
(setq txtht (getdist (strcat "\nChieu cao text <" (rtos (getvar "textsize") 2 2) ">: ")))
(if (null txtht) (setq txtht (getvar "textsize")))
(command "text" "m" pnt txtht 0 (strcat (rtos(/ L 1000) 2 2) "m"))
)
)

  • 3

#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 26 December 2011 - 02:48 PM

Mình có nhờ Anh Vo Quang Tue ( hay Võ Quang Tuệ gì gì đấy :mellow: ) làm cho Lisp đo khoảng cách rất hay như sau
-chọn điểm thứ nhất
-chọn điểm thứ hai
-Kết quả thay cho một số có sẵn

(defun C:TL3( / ss L te p1 p2 )

(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))


(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
-> Enter để kết thúc lệnh

- Bây giờ mình muốn kết quả tìm được phải ghi ra nơi mình chọn, không phải là thay cho một số có sẵn như trước.

Nhờ mọi người sửa giúp.

Tue_NV là nick của Võ Quang Tuệ. Võ Quang Tuệ lập ra nick Tue_NV .. hề hề
Yêu cầu của bạn đây :



(defun C:TL3( / ss L te p1 p2 hei P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not hei) (setq hei (getreal "\nNhap chieu cao Text:")))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (cons 40 hei)
(cons 10 p) (cons 11 p)))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
)
)
Bạn chú ý : Text trong trường hợp mà bạn pick chọn lấy theo Style hiện hành
Tue_NV đã lập ra 2 trường hợp :
Bạn thích pick vào Text thì gõ T
thích chọn điểm chèn cho Text thì pick chọn điểm chèn cho Text

Đúng ý rồi nhé
  • 1

#5 vantuan18nd

vantuan18nd

    biết vẽ rectang

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

Đã gửi 26 December 2011 - 02:50 PM

Bạn đã đọc nội quy, vậy hãy cố cho code vào thẻ code nhé. Lần đầu này mình sửa hộ bạn


(defun c:tl3 (/) (vl-load-com)
(vla-addtext
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(rtos (getdist (getpoint "\nP1 :") "\nP2 :") 2 2)
(vlax-3d-point (getpoint "\nDiem dat KQ :"))
(* (getvar "dimtxt")(getvar "dimscale"))
)
(princ))

Cảm ơn nhé . mình đang rất cần. Đúng ý mình rùi đấy
  • 0

#6 vantuan18nd

vantuan18nd

    biết vẽ rectang

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

Đã gửi 26 December 2011 - 03:26 PM

Tue_NV là nick của Võ Quang Tuệ. Võ Quang Tuệ lập ra nick Tue_NV .. hề hề
Yêu cầu của bạn đây :




(defun C:TL3( / ss L te p1 p2 hei P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not hei) (setq hei (getreal "\nNhap chieu cao Text:")))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (cons 40 hei)
(cons 10 p) (cons 11 p)))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
)
)
Bạn chú ý : Text trong trường hợp mà bạn pick chọn lấy theo Style hiện hành
Tue_NV đã lập ra 2 trường hợp :
Bạn thích pick vào Text thì gõ T
thích chọn điểm chèn cho Text thì pick chọn điểm chèn cho Text

Đúng ý rồi nhé

Cái của bác Tuệ ấy
- Khi nhấn T thì nó báo Invalid Point , không được rùi.
-còn cái chọn điểm pick ấy. sao Bác không làm thế này:
+chọn điểm cần ghi
+Kết quả : Chọn cái text để mình "ma" cho nó giống, thay vì phải nhập chiều cao chữ, mà chiều cao chữ thì lại phải đi tìm. hơn nữa Text của bác lại không giống bản vẽ em đang dùng
  • 0

#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 26 December 2011 - 03:39 PM

Cái của bác Tuệ ấy
- Khi nhấn T thì nó báo Invalid Point , không được rùi.
-còn cái chọn điểm pick ấy. sao Bác không làm thế này:
+chọn điểm cần ghi
+Kết quả : Chọn cái text để mình "ma" cho nó giống, thay vì phải nhập chiều cao chữ, mà chiều cao chữ thì lại phải đi tìm. hơn nữa Text của bác lại không giống bản vẽ em đang dùng

Theo ý bạn đây :



(defun C:TL3( / ss L te p1 p2 textmau P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau))
(cons 10 p) (cons 11 p) (assoc 7 (entget textmau))
))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
)
)

  • 2

#8 vantuan18nd

vantuan18nd

    biết vẽ rectang

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

Đã gửi 26 December 2011 - 03:44 PM

có thế chứ.
thanks bác nhiều lắm
em dùng được rồi
  • 0

#9 vantuan18nd

vantuan18nd

    biết vẽ rectang

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

Đã gửi 26 December 2011 - 03:48 PM

Bác tue_vn, em nhờ tí nữa,
bác sang topic
[Yêu cầu]Tính cao độ một điểm bất kỳ khi có cao độ cho trước

Lam hộ em với
  • 0

#10 hamster2102

hamster2102

    biết lệnh copy

  • Advance Member
  • PipPipPip
  • 111 Bài viết
Điểm đánh giá: 21 (tàm tạm)

Đã gửi 15 July 2012 - 11:36 PM

gửi lời cảm ơn đến bác @Tue_NV. lisp tl3 của bác viết giúp em nhiều lắm, em giờ sau khi dùng lệnh dal đo và ghi kích thước xong lại dung tl3 để lấy số liệu kích thước đó chuyển vào bảng nếu cải tiến cho 2 cái gộp làm 1 thì còn giảm cho em thêm hơn 1/5 thời gian nữa ^^
  • 0
Nếu biết rằng em đã lấy chồng
Anh mừng biết mấy em biết không
Bao năm quen biết, bao năm mệt
Tính ra cũng khổ mấy năm ròng

#11 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 15 July 2012 - 11:39 PM

gửi lời cảm ơn đến bác @Tue_NV. lisp tl3 của bác viết giúp em nhiều lắm, em giờ sau khi dùng lệnh dal đo và ghi kích thước xong lại dung tl3 để lấy số liệu kích thước đó chuyển vào bảng nếu cải tiến cho 2 cái gộp làm 1 thì còn giảm cho em thêm hơn 1/5 thời gian nữa ^^

Mới trả lời xong cho bạn ở chủ đề bên kia rồi. Lần sau nhớ search trước khi post bài nhé
  • 1

#12 hamster2102

hamster2102

    biết lệnh copy

  • Advance Member
  • PipPipPip
  • 111 Bài viết
Điểm đánh giá: 21 (tàm tạm)

Đã gửi 16 July 2012 - 08:28 AM

cập nhật thêm chức năng nữa tương tự lệnh này các bạn nhé lệnh bác Tue có đổi thành dkt ( đây là lisp bác Tue_NV viết cho em ^^ )
cái này có thể đo và ghi kích thước 2 điểm bất kỳ đồng thời copy con số kích thước dưới dạng text thẳng đứng ngay tại con trỏ cho ta đặt ở vị trí khác bất kỳ ^^ lệnh rất nhanh và gọn không có động tác giả nào^^

http://www.cadviet.c...3/52440_dkt.lsp
  • 0
Nếu biết rằng em đã lấy chồng
Anh mừng biết mấy em biết không
Bao năm quen biết, bao năm mệt
Tính ra cũng khổ mấy năm ròng

#13 knguienn

knguienn

    biết pan

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

Đã gửi 09 June 2013 - 09:59 AM

Cám ơn bác Tue_NV, lisp rất hay ! rất hữu dụng :D


  • 0

#14 trangnhung

trangnhung

    biết vẽ pline

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

Đã gửi 05 November 2014 - 08:41 AM

em thấy líp rất hay. Nhưng e có 1 vấn đề cần các bác giúp. lisp của bác  Tue_NV chỉ đo đc đường chéo và đường thẳng. Trong trường hơpk của e, đường thẳng cần đo là 1 đường spl thì ko dùng đc. Rất mong bác giúp đỡ. nếu đc bác sửa lại là: chọn đường cần đo, điểm 1, điểm 2. Ghi kết quả ra text có sẵn. E chân thành cảm ơn !


  • 0

#15 trangnhung

trangnhung

    biết vẽ pline

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

Đã gửi 05 November 2014 - 08:46 AM

Bác Tue_NV giúp e với. lisp tl3 rất hay. nhưng nó chỉ đo đc đường chéo và đường thẳng. Trường hợp của e là đo khoảng cách của đường cong, hay đường spl. Bác có thể chỉnh lisp

giúp e như sau đc không ạ: chọn đường cần đo. Pick điểm 1, điểm 2, ghi kết quả ra text có sẵn. E chân thành cảm ơn !. Chúc bác mạnh giỏi !


  • 0

#16 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 05 November 2014 - 11:21 AM

- hi nhoc góp vui tí ^^, các dạng đường cong nhoc nghĩ chỉ có  cách chọn mới tính đc chiều dài của nó, nhoc mót đc của mấy anh, viết lại để tính riêng cho dạng đường cong, bạn dùng thử xem, còn gộp 2 cái của anh Tue lun thì suy nghĩ thêm ^^

;;;--------------------------------------------------------------------
(defun Length1(e) 
(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TLC(/ L edd ss1 e)
(prompt "Chon duong cong mun tinh kich thuoc")
(while (setq ss1 (ssget "+.:E:S" (list (cons 0 "ARC,CIRCLE,ELLIPSE,SPLINE"))))
(progn
(setq L 0.0)
(while (setq e (ssname ss1 0))    
	(setq L (+ L (length1 e)))    
	(ssdel e ss1))
(setq edd (entget (car (entsel "\nchon text ghi ket qua:"))))
(entmod (subst (cons 1 (rtos L 2 2)) (assoc 1 edd) edd))
)
)
(princ "\n")
(princ "xong")
(princ)
)

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

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








#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 November 2014 - 11:35 AM

Like ủng hộ nhoclangbat đã.

P/s : Yêu cầu của bạn trangnhung khác với của nhoclangbat viết 1 chút, k phải tính toàn bộ length mà tính chiều dài 2 điểm trên đối tượng đó. Mấy hôm trước vừa có người hỏi trong topic Hỏi về thuật toán hay sao ý 


  • 0

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


#18 nhoclangbat

nhoclangbat

    Edu level: li10

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

Đã gửi 05 November 2014 - 11:59 AM

- ? nếu chỉ tính chiều dài 2 điểm pick thì nhoc thấy lsp anh Tue đâu quan tâm nó dạng thẳng hay dạng cong nhỉ ^^

- 1 chỗ nữa thì lsp TL3 của anh Tue hình như thiếu hay sao ấy nhoc thấy nó ngộ ngộ ở dòng này ^^

(setq te (entget(car("\n Chon Text de gan ket qua :")))

- sao ko có entsel sau car nhỉ, nhoc chạy thử nguyên bản báo lỗi, nên  thêm entsel vào thì ok


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

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








#19 ketxu

ketxu

    Copier - Paster - Editor

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

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

Chắc diễn đàn đang bị lỗi view :)

Đến giờ nghỉ rồi, quick code cho nhoc phần 2 point length này, nhóc hoàn thành yêu cầu cho cứng tay. :)

(defun _d2p(e p1 p2) ;Getdist along curve by : Ename P1 P2	
	(abs (apply '- (mapcar '(lambda(x)(vlax-curve-getDistAtPoint e (trans (vlax-curve-getclosestpointto e x) 1 0))) (list p1 p2))))
)

  • 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


#20 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 05 November 2014 - 12:09 PM

- ? nếu chỉ tính chiều dài 2 điểm pick thì nhoc thấy lsp anh Tue đâu quan tâm nó dạng thẳng hay dạng cong nhỉ ^^

- 1 chỗ nữa thì lsp TL3 của anh Tue hình như thiếu hay sao ấy nhoc thấy nó ngộ ngộ ở dòng này ^^

- sao ko có entsel sau car nhỉ, nhoc chạy thử nguyên bản báo lỗi, nên  thêm entsel vào thì ok

1). Chắc Tue_NV sơ ý viết thiếu, như hôm qua DVH cũng sơ ý và có Nhoc cứu đó.

2). Chủ top muốn lấy khoảng cách giữa 2 điểm thuộc đường cong Nhoc à.


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