Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2001 manhdlk

manhdlk

    biết pan

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

Đã gửi 28 September 2010 - 06:30 PM

Chào bạn manhlk,
Hề hề hề, cái đề bài bạn ra sai tóe loe rồi, hổng làm được đâu, đừng mất công nghĩ nữa....
Hãy xem lại hình học phẳng cơ bản từ hồi lớp 8 bạn nhé....
Hề hề hề....



Hề hề hề, sai tóe loe là sao?
Có góc giao giữa hai đường thẳng rồi, có chiều dài tiếp tuyến rồi, chỉ đi tìm R thôi mà.
Công thức tính R đây luôn:
R=T/(tan(pi-a/2))
T: chiều dài đường tang (chiều dài tiếp tuyến) - chính là khoảng cách OA, OB
a: góc hợp giữa OA và OB (tính bằng rad)

Phần còn lại là của các bác.
Hề hề hề
  • 0

#2002 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 28 September 2010 - 06:42 PM

Chào các bác.

Em có một bài toán này mong muốn các bác giúp em. Em cũng đã search trên forum nhưng không thấy.
Đề bài như thế này: Cho hai đường thẳng cắt nhau, em muốn vẽ một cung tròn tiếp tuyến với hai đường thẳng này tại tiếp điểm cho trước. Cảm ơn các bác trước.
Hình đã gửi

Của bạn đây.

;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
p2 (getpoint "\nchon diem tiep xuc thu hai:")
giao (inters pg1 pg2 pg3 pg4)
ang (/ (- (+ (angle giao p1) (* pi 2)) (angle giao p2)) 2)
d (distance giao p1)
dr (/ d (cos ang))
angr (+ (angle giao p2) ang)
pc (polar giao angr dr)
)
(command "arc" "c" pc p1 p2)
)

Hình đã gửi
Mình chưa có thời gian kiểm tra nên tạm phân ra làm 2 trường hợp.
BS: khoảng cách từ 0 tới A phải bằng từ 0 tới B
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2003 manhdlk

manhdlk

    biết pan

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

Đã gửi 28 September 2010 - 06:51 PM

Cảm ơn bác phamngoctukts đã quan tâm.

Em vừa kiểm tra xong, và mạo muội đề nghị bác chỉnh lại cho em một chút nữa.
Em chỉ cần trường hợp 2 thôi, và không nhất thiết phải chọn 2 tiếp điểm ạ. Chỉ cần chọn 1 thôi, vì OA=OB mà.
Mong bác quan tâm.
  • 0

#2004 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 28 September 2010 - 07:01 PM

Cảm ơn bác phamngoctukts đã quan tâm.

Em vừa kiểm tra xong, và mạo muội đề nghị bác chỉnh lại cho em một chút nữa.
Em chỉ cần trường hợp 2 thôi, và không nhất thiết phải chọn 2 tiếp điểm ạ. Chỉ cần chọn 1 thôi, vì OA=OB mà.
Mong bác quan tâm.

Đã fix cho bạn rồi này.

;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
p2 (getpoint "\nchon diem tiep xuc thu hai:")
giao (inters pg1 pg2 pg3 pg4)
ang (/ (- (+ (angle giao p1) (* pi 2)) (angle giao p2)) 2)
d (distance giao p1)
dr (/ d (cos ang))
angr (+ (angle giao p2) ang)
pc (polar giao angr dr)
)
(if (< (angle pc p1) (angle pc p2))
(command "arc" "c" pc p1 p2)
(command "arc" "c" pc p2 p1)
)
)
Quên mất ý thứ 2 của bạn dợi chút nhé.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2005 manhdlk

manhdlk

    biết pan

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

Đã gửi 28 September 2010 - 07:29 PM

Em đợi mãi chẳng thấy bác phamngoctukts đâu cả, bác hứa với em rồi mà...
Hay là bác nào vào hoàn thiện đoạn lisp trên cho em với.
Ý của em là chỉ cần chọn 1 trong hai điểm tiếp tuyến thôi. Chọn 2 điểm mất công trim hoặc extend.
  • 0

#2006 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 28 September 2010 - 08:07 PM

Em đợi mãi chẳng thấy bác phamngoctukts đâu cả, bác hứa với em rồi mà...
Hay là bác nào vào hoàn thiện đoạn lisp trên cho em với.
Ý của em là chỉ cần chọn 1 trong hai điểm tiếp tuyến thôi. Chọn 2 điểm mất công trim hoặc extend.

Mình đang bận tí bạn thông cảm nhé. Với yêu cầu thứ 2 của bạn thì code trên không dùng được mà phải viết theo hướng khác. Bạn chịu kho đợi nhé
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2007 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 28 September 2010 - 08:21 PM

Cảm ơn bác phamngoctukts đã quan tâm.

Em vừa kiểm tra xong, và mạo muội đề nghị bác chỉnh lại cho em một chút nữa.
Em chỉ cần trường hợp 2 thôi, và không nhất thiết phải chọn 2 tiếp điểm ạ. Chỉ cần chọn 1 thôi, vì OA=OB mà.
Mong bác quan tâm.

Chào bạn manhlk,
Cái sai tóe loe chính là ở đây: Chỉ cần chọn 1 thôi, vì OA=OB mà.
Nói chính xác hơn chỉ cho phép bạn chọn 1 tiếp điểm, trong khi đầu bài bạn cho lại cho cả hai tiếp điểm. Vậy là sai vì nếu OA /= OB thì bạn có vẽ cả ngày cũng chả ra được. Bạn hiểu chứ.
Về lý thuyết, một đường tròn tiếp xúc với hai cạnh của một góc thì tâm sẽ luôn nằm trên đường phân giác của góc đó và do vậy chỉ cần từ 1 điểm tiếp xúc bạn dựng đường vuông góc với cạnh mang điểm tiếp xúc đó của góc . Giao điểm của đường mới dựng và đường phân giác sẽ là tâm đường tròn bạn ạ.
Khi bạn cho cả hai điểm tiếp xúc trên hai cạnh thì cái xác xuất bạn dựng được hình sẽ là 1/ ty tỷ bạn ạ.
Rất mong bạn cẩn trọng khi ra đề cho người khác kẻo mà làm mất công vô ích.
Chào bạn.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2008 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 28 September 2010 - 08:38 PM

Xin lỗi TUE nhiều!Do bài nhiều bài viết dài quá nên mình ko thấy bài viết TUE giúp mình!Xin chân thành cảm ơn TUE rất nhiều!Mình đang test có gì mình sẽ báo liền!
Cảm ơn TUE và bác BÌNH rất nhiều!

Hề hề hề,
Xong rồi, cuối cùng cũng nghĩ ra được giải pháp chung nhất, bắt chấp kích thước đường kinh và kích thước chiều dài của ống. Chỉ cần bạn Truongthanh nhập tẽt theo đúng điều kiện như sau: giữa các ký tự chỉ đường kính ống và gạch nối là một khoảng trắng, giữa gạch nối và các ký tự chiều dài ống là một khoảng trắng,
giữa các ký tự chỉ chiều dài và gạch nối phía sau cũng là một khoảng trắng (trong trường hợp ống thoát nước) là OK.
Cũng giống lisp trước bạn Truongthanh phải lưu ý là nội dung kê khai trong bảng thống kê với ống cấp nước sẽ luôn là ỐNG NHỰA uPVC và kích thước đường kính ống, còn trong bảng thống kê cho đường ống thoát nước luôn là CỐNG BTCT và đường kính ống bạn nhé.
Cái vụ này là do bản mẫu của bạn như vậy, nếu bạn muốn thay đổi cái tên khác thì bạn phải thay đổi cái biến prtxt trong hàm chính bạn nhé.
Hy vọng bạn sẽ hài lòng.

(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (wcmatch txt "*-*-*")
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq chuoi (nth 0 lst))
(tach chuoi)
(setq a t1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(tach b )
(if (= t1 a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(tach c )
(setq tdd (+ tdd (atof t2))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tach (txt / i n k m )
(setq i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(setq t2 (substr t2 1 (- m 2)))
)
)
)

)






PS: Bạn hãy chú ý so sánh hai cái lisp của mình để thấy được sự khác nhau giữa hai cách tách chuỗi bạn nhé. Cách sau tuy phức tạp nhưng giải quyết được vấn đề triệt để hơn bạn ạ. Qua đó bạn cũng se4ho5c được một số cái hay hay đó. Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2009 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 September 2010 - 09:34 PM

Chào bạn manhlk,
Cái sai tóe loe chính là ở đây: Chỉ cần chọn 1 thôi, vì OA=OB mà.
Nói chính xác hơn chỉ cho phép bạn chọn 1 tiếp điểm, trong khi đầu bài bạn cho lại cho cả hai tiếp điểm. Vậy là sai vì nếu OA /= OB thì bạn có vẽ cả ngày cũng chả ra được. Bạn hiểu chứ.
Về lý thuyết, một đường tròn tiếp xúc với hai cạnh của một góc thì tâm sẽ luôn nằm trên đường phân giác của góc đó và do vậy chỉ cần từ 1 điểm tiếp xúc bạn dựng đường vuông góc với cạnh mang điểm tiếp xúc đó của góc . Giao điểm của đường mới dựng và đường phân giác sẽ là tâm đường tròn bạn ạ.
Khi bạn cho cả hai điểm tiếp xúc trên hai cạnh thì cái xác xuất bạn dựng được hình sẽ là 1/ ty tỷ bạn ạ.
Rất mong bạn cẩn trọng khi ra đề cho người khác kẻo mà làm mất công vô ích.
Chào bạn.

Chào bác PhamThanhBinh
Có lẽ bác chưa hiểu hết ý của bạn manhlk
Ý theo Tue_NV hiểu là như thế này :
Cho đường thẳng d1 cắt đường thẳng d2 tại O.
- Trên d1 lấy 1 điểm A. Lấy O làm tâm dựng 1 đường tròn, bán kính OA cắt d2 tại B
=> OA=OB
- Xác định góc AOB = a => góc ở tâm cung cần dựng (180 - a) , có thể tính ra được bán kính cong
- Xác định cung AB cần dựng
Đơn giản là vậy.
Bạn manhlk chỉ cần xác định 1 điểm A trên d1 thôi rồi dựng cung tiếp xúc với d1 và d2
  • 1

#2010 hoan2182

hoan2182

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2646 Bài viết
Điểm đánh giá: 832 (rất tốt)

Đã gửi 28 September 2010 - 10:42 PM

Chào các bác.

Em có một bài toán này mong muốn các bác giúp em. Em cũng đã search trên forum nhưng không thấy.
Đề bài như thế này: Cho hai đường thẳng cắt nhau, em muốn vẽ một cung tròn tiếp tuyến với hai đường thẳng này tại tiếp điểm cho trước. Cảm ơn các bác trước.
Hình đã gửi

Đây là bài toán đơn giản, cách dựng hình cũng đơn giản.
Hình như các bác quen làm những việc to lớn phức tạp... nên cái việc đơn giản cũng tưởng là phức tạp... Giống như cái nhà bác học nào đó, khi làm nhà đã đục hai lỗ trên một bức tường :
- Một lỗ to cho chó chui ra chui vào
- Một lỗ nhỏ cho mèo chui vào chui ra
  • 1

Gió đưa cây cải về trời

Rau răm ở lại chịu lời đắng cay...


#2011 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 28 September 2010 - 11:10 PM

Đây là bài toán đơn giản, cách dựng hình cũng đơn giản.
Hình như các bác quen làm những việc to lớn phức tạp... nên cái việc đơn giản cũng tưởng là phức tạp... Giống như cái nhà bác học nào đó, khi làm nhà đã đục hai lỗ :
- Một lỗ to cho chó chui ra chui vào
- Một lỗ nhỏ cho mèo chui vào chui ra

Hề hề hề,
Bác này chỉ được cái nói đúng. Tuy nhiên càng đơn giản lại càng phải trình bày cho chính xác bác ạ. Phàm đã là dân kỹ thuật mà lại nói kiểu mập mờ , lấp lửng gây khó hiểu cho người khác thì lại càng ..... phi kỹ thuật bác ạ. Dân kinh doanh thì mình chả dám bàn vì đôi khi họ càng mập mờ họ càng có lợi.
Cho dù là mình hiểu nhầm đi chăng nữa thì cũng bởi cái cách trình bày của bạn manhlk mà ra. Vậy nên có nhắc một chút hẳn cũng chưa phải là thừa bác ạ......
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2012 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 28 September 2010 - 11:18 PM

Đây là bài toán đơn giản, cách dựng hình cũng đơn giản.
Hình như các bác quen làm những việc to lớn phức tạp... nên cái việc đơn giản cũng tưởng là phức tạp... Giống như cái nhà bác học nào đó, khi làm nhà đã đục hai lỗ trên một bức tường :
- Một lỗ to cho chó chui ra chui vào
- Một lỗ nhỏ cho mèo chui vào chui ra

Nghĩ thì đơn giản nhưng bạn thử bắt tay vào làm xem.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2013 manhdlk

manhdlk

    biết pan

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

Đã gửi 28 September 2010 - 11:40 PM

Chào các bác.
Trước hết xin cảm ơn bác phamngoctukts về những gì bác đã làm cho yêu cầu của em.
@ all: Vấn đề con con của em mà các bác mổ xẻ chi tiết quá. Thật vinh hạnh cho một newbie như em.
@ phamthanhbinh: Quay trở lại yêu cầu của em nhé: Bác không hiểu đề bài sao mà còn bắt em về học lớp 8? Em thiết tưởng đề bài của em quá ư chi tiết, rõ ràng và đơn giản. Chỉ bác là suy nghĩ hơi cao siệu thôi ạ. Ai chặng biết OA=OB, em ghi rõ A, B vì muốn thao tác sẽ chọn một tiếp điểm bất kỳ trên hai đường thẳng, bác ợ. Sau này em đề cập đến OA và OB là vì đoạn lisp của bác phamngoctukts bắt chọn 2 tiếp điểm, nên em nhắc bác ấy đơn giản lại giúp em. Thế mà bác cũng ...super soi được, lại còn ...kỹ thuật với chẳng phi kỹ thuật, mập mờ với mập tỏ. Hề hề, vài lời mong bác đừng giận.
  • 0

#2014 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 28 September 2010 - 11:45 PM

Hề hề hề,
Xong rồi, cuối cùng cũng nghĩ ra được giải pháp chung nhất, bắt chấp kích thước đường kinh và kích thước chiều dài của ống. Chỉ cần bạn Truongthanh nhập tẽt theo đúng điều kiện như sau: giữa các ký tự chỉ đường kính ống và gạch nối là một khoảng trắng, giữa gạch nối và các ký tự chiều dài ống là một khoảng trắng,
giữa các ký tự chỉ chiều dài và gạch nối phía sau cũng là một khoảng trắng (trong trường hợp ống thoát nước) là OK.
Cũng giống lisp trước bạn Truongthanh phải lưu ý là nội dung kê khai trong bảng thống kê với ống cấp nước sẽ luôn là ỐNG NHỰA uPVC và kích thước đường kính ống, còn trong bảng thống kê cho đường ống thoát nước luôn là CỐNG BTCT và đường kính ống bạn nhé.
Cái vụ này là do bản mẫu của bạn như vậy, nếu bạn muốn thay đổi cái tên khác thì bạn phải thay đổi cái biến prtxt trong hàm chính bạn nhé.
Hy vọng bạn sẽ hài lòng.


(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (wcmatch txt "*-*-*")
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq chuoi (nth 0 lst))
(tach chuoi)
(setq a t1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(tach b )
(if (= t1 a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(tach c )
(setq tdd (+ tdd (atof t2))
lo (substr c 1 4)
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tach (txt / i n k m )
(setq i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(setq t2 (substr t2 1 (- m 2)))
)
)
)

)






PS: Bạn hãy chú ý so sánh hai cái lisp của mình để thấy được sự khác nhau giữa hai cách tách chuỗi bạn nhé. Cách sau tuy phức tạp nhưng giải quyết được vấn đề triệt để hơn bạn ạ. Qua đó bạn cũng se4ho5c được một số cái hay hay đó. Chúc bạn vui.

Cảm ơn bác rất nhiều!Lisp chạy rất OK nhưng sao cái đường kính 4 chữ số nó vẫn ko hiểu vậy bác!Ví dụ 1000 thì nó hiểu 100, 1200 thì nó hiểu là 120! Bác xem lại giúp em nhé!
  • 0

#2015 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 29 September 2010 - 12:26 AM

Cảm ơn bác rất nhiều!Lisp chạy rất OK nhưng sao cái đường kính 4 chữ số nó vẫn ko hiểu vậy bác!Ví dụ 1000 thì nó hiểu 100, 1200 thì nó hiểu là 120! Bác xem lại giúp em nhé!

Hề hề hề,
Xin lỗi bạn Truongthanh,
Do mình chỉ kiểm tra hàm tách chuỗi thấy nó tách tốt mà không sửa lại trong hàm (seplst .....) bạn ạ.
Bạn chỉ cần sửa chút xíu như sau là OK liền.
Bạn thay dòng code: lo (substr c 1 4) trong hàm (seplst ..... ) thành lo t1
Cái lisp đã sửa như sau:

(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (wcmatch txt "*-*-*")
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq chuoi (nth 0 lst))
(tach chuoi)
(setq a t1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(tach b )
(if (= t1 a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(tach c)
(setq tdd (+ tdd (atof t2))
lo t1
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tach (txt / i n k m )
(setq i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(setq t2 (substr t2 1 (- m 2)))
)
)
)

)






Thành thật xin lỗi bạn.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2016 hoan2182

hoan2182

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2646 Bài viết
Điểm đánh giá: 832 (rất tốt)

Đã gửi 29 September 2010 - 12:28 AM

Chào các bác.
Trước hết xin cảm ơn bác phamngoctukts về những gì bác đã làm cho yêu cầu của em.
@ all: Vấn đề con con của em mà các bác mổ xẻ chi tiết quá. Thật vinh hạnh cho một newbie như em.
@ phamthanhbinh: Quay trở lại yêu cầu của em nhé: Bác không hiểu đề bài sao mà còn bắt em về học lớp 8? Em thiết tưởng đề bài của em quá ư chi tiết, rõ ràng và đơn giản. Chỉ bác là suy nghĩ hơi cao siệu thôi ạ. Ai chặng biết OA=OB, em ghi rõ A, B vì muốn thao tác sẽ chọn một tiếp điểm bất kỳ trên hai đường thẳng, bác ợ. Sau này em đề cập đến OA và OB là vì đoạn lisp của bác phamngoctukts bắt chọn 2 tiếp điểm, nên em nhắc bác ấy đơn giản lại giúp em. Thế mà bác cũng ...super soi được, lại còn ...kỹ thuật với chẳng phi kỹ thuật, mập mờ với mập tỏ. Hề hề, vài lời mong bác đừng giận.

Chào các bác.
Em có một bài toán này mong muốn các bác giúp em. Em cũng đã search trên forum nhưng không thấy.
Đề bài như thế này: Cho hai đường thẳng cắt nhau, em muốn vẽ một cung tròn tiếp tuyến với hai đường thẳng này tại tiếp điểm cho trước. Cảm ơn các bác trước.
Hình đã gửi

.Em chỉ cần trường hợp 2 thôi, và không nhất thiết phải chọn 2 tiếp điểm ạ. Chỉ cần chọn 1 thôi, vì OA=OB mà.
Mong bác quan tâm.

Câu hỏi ban đầu của anh đã khiến bác Bình ngỡ tưởng là hai điểm OA và OB không bằng nhau, nên bắt anh về học lại lớp 8 là đúng (với cái tính thích đùa giỡn của bác ấy).
Còn nếu OA= OB thì sự việc trở nên quá đơn giản, đâu cần phải viết lisp???
Nguyên nhân mang đến sự hiểu lầm của bác Bình là do anh viết:” Em cũng đã search trên forum nhưng không thấy.”
  • 0

Gió đưa cây cải về trời

Rau răm ở lại chịu lời đắng cay...


#2017 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 29 September 2010 - 12:57 AM

Chào các bác.
Trước hết xin cảm ơn bác phamngoctukts về những gì bác đã làm cho yêu cầu của em.
@ all: Vấn đề con con của em mà các bác mổ xẻ chi tiết quá. Thật vinh hạnh cho một newbie như em.
@ phamthanhbinh: Quay trở lại yêu cầu của em nhé: Bác không hiểu đề bài sao mà còn bắt em về học lớp 8? Em thiết tưởng đề bài của em quá ư chi tiết, rõ ràng và đơn giản. Chỉ bác là suy nghĩ hơi cao siệu thôi ạ. Ai chặng biết OA=OB, em ghi rõ A, B vì muốn thao tác sẽ chọn một tiếp điểm bất kỳ trên hai đường thẳng, bác ợ. Sau này em đề cập đến OA và OB là vì đoạn lisp của bác phamngoctukts bắt chọn 2 tiếp điểm, nên em nhắc bác ấy đơn giản lại giúp em. Thế mà bác cũng ...super soi được, lại còn ...kỹ thuật với chẳng phi kỹ thuật, mập mờ với mập tỏ. Hề hề, vài lời mong bác đừng giận.

Chào bạn manhdlk,
Rất cám ơn về những lời phản bác của bạn.
Tuy nhiên, tiên trách kỷ hậu trách nhân. Cứ cho là mình đã hiểu nhầm thì cũng xin bạn hãy cố gắng trình bày làm sao để một người ngu lâu như mình cũng có thể hiểu được cái bạn muốn.
Còn bảo mình là super soi thì cũng chả sai, vì mình vốn là dân đi mót mà, chả soi cho kỹ thì còn có thể mót được gì hử bạn.
Cũng chính vì bạn đã vạch ra hai điểm tiếp xúc A và B trước khi dựng hình như vậy nên bác phamngoctukts mới phải lăn tăn nghĩ đến việc đặt điều kiện OA=OB để dựng hình. Cái đó có phải là gây khó cho bác ấy không????
Bạn đã học qua lớp 8, ắt phải biết bài toán dựng hình yêu cầu phân tích trước khi dựng, dựng xong lại phải chứng minh và biện luận nó. Vậy bạn nghĩ gì khi cho đấu bài với các dữ kiện thừa như vậy mà không một lời giải thích kèm theo.
Mình tuy chả khôn song cũng chả mong mót phải những đề bài oái oăm như của bạn.
Giận bạn ư??? Giận làm gì và để được gì??? Chỉ mong bạn hãy suy ngẫm cho kỹ những gì mình nói để may ra có thể có ích cho chính bạn.
Chúc bạn luôn vui vẻ khi tham gia diễn đàn và một lần nữa cám ơn sự phản bác của bạn.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2018 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 29 September 2010 - 01:49 AM

Câu hỏi ban đầu của anh đã khiến bác Bình ngỡ tưởng là hai điểm OA và OB không bằng nhau, nên bắt anh về học lại lớp 8 là đúng (với cái tính thích đùa giỡn của bác ấy).
Còn nếu OA= OB thì sự việc trở nên quá đơn giản, đâu cần phải viết lisp???
Nguyên nhân mang đến sự hiểu lầm của bác Bình là do anh viết:” Em cũng đã search trên forum nhưng không thấy.”

Đúng là cái này dùng thủ công còn nhanh hơn dùng lisp.
Nó phân ra quá nhiều trường hợp. Trong hàm đặt quá nhiều điều kiện. Mình đã đặt thế này rồi mà vẫn thiếu lúc thì đúng lúc thì sai. Thật đau cái đầu.

;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4)
)
(if (equal giao pg1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1))
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(if (< (angle giao p1) (angle giao p2))
(setq ang (/ (- (* pi 2) (- (angle giao p2) (angle giao p1))) 2))
(setq ang (/ (- (angle giao p1) (angle giao p2)) 2))
)
(setq d (distance giao p1)
dr (/ d (cos ang))
angr (+ (angle giao p2) ang)
pc (polar giao angr dr)
)
(if (< (angle pc p1) (angle pc p2))
(command "arc" "c" pc p1 p2)
(command "arc" "c" pc p2 p1)
)
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2019 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 29 September 2010 - 05:41 AM

Đây là bài toán đơn giản, cách dựng hình cũng đơn giản.
Hình như các bác quen làm những việc to lớn phức tạp... nên cái việc đơn giản cũng tưởng là phức tạp... Giống như cái nhà bác học nào đó, khi làm nhà đã đục hai lỗ trên một bức tường :
- Một lỗ to cho chó chui ra chui vào
- Một lỗ nhỏ cho mèo chui vào chui ra

Nghĩ thì đơn giản nhưng bạn thử bắt tay vào làm xem.

Hì hì đơn giản lắm lắm. Đây là cách dựng cung Arc tiếp xúc với 2 đường thẳng d1 d2 cắt nhau. Hổng cần đến Lisp vẫn cứ dựng cung arc 1 cách nhanh nhất.
Bạn suy nghĩ phức tạp quá thành ra code của bạn cũng phức tạp theo. Bạn nói "thử bắt tay vào xem" thì xin thưa với bạn là Tue_NV đã bắt tay vào rồi. XOng hồi tối hôm qua cơ, sáng sơm này chờ bạn post lên mới có hồi âm
Nó đây : Lisp ve cung VATT
Bạn Tu va manhdlk thử xem

Bạn Tú thử câu hỏi này xem. Và trả lời xong câu hỏi này thì Tue_NV tin rằng bạn Tú sẽ tự mình xây dựng được code trên theo 1 cách ngắn gọn nhất
Câu hỏi đó nằm ở đây : Để topic này không rơi vào quên lãng

Đúng là cái này dùng thủ công còn nhanh hơn dùng lisp.
Nó phân ra quá nhiều trường hợp. Trong hàm đặt quá nhiều điều kiện. Mình đã đặt thế này rồi mà vẫn thiếu lúc thì đúng lúc thì sai. Thật đau cái đầu.


;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4)
)
(if (equal giao pg1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1))
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(if (< (angle giao p1) (angle giao p2))
(setq ang (/ (- (* pi 2) (- (angle giao p2) (angle giao p1))) 2))
(setq ang (/ (- (angle giao p1) (angle giao p2)) 2))
)
(setq d (distance giao p1)
dr (/ d (cos ang))
angr (+ (angle giao p2) ang)
pc (polar giao angr dr)
)
(if (< (angle pc p1) (angle pc p2))
(command "arc" "c" pc p1 p2)
(command "arc" "c" pc p2 p1)
)
)

Code quá phức tạp. Đau đầu 1 chút thì đâu có sao nếu như biết thêm 1 cái mới. Giải được câu đố trên sẽ hết đau liền. Đây là kiến thức về cách vẽ cung được học hồi vẽ các lênh CAD cơ bản

@truongthanh : đã fix lỗi thứ tự đường kính theo quy luật cho bạn ở bài viết 2018
  • 1

#2020 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 29 September 2010 - 06:58 AM

á á..Em mạn phép test code thì được kết quả như sau :
Đường màu đỏ là 0A,0B của e.2 đường màu xanh là kết quả sau ki chạy lsp.Còn đường màu xanh dương đứt đứt là e vẽ vào để thấy rõ 0A=0B,và 2 cung tròn kia cũng ằm gọn lỏn trong ấy luôn.Không biết thao tác của e có gì sai không nữa :|
Hình đã gửi
  • 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