Đến nội dung


Hình ảnh
- - - - -

Viết lisp nối suy đỉnh đường cong tròn


  • Please log in to reply
13 replies to this topic

#1 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 12 July 2010 - 06:00 PM

Chào các anh chị. Dạo này mới đi làm nên yêu cầu cv cần tiến độ nên cần làm gấp 1 cv có nội sung như sau:
+ Bài toán thuận: Cho hai đường thẳng tiếp xúc nhau và dùng lệnh Fillet bo 2 đường thẳng bằng cung tròn R=300m.
+ Bài toán ngược như sau: Bây giờ đã xóa đường thẳng và chỉ còn lại cung tròn bk R=300m và 2 tiếp điểm của đưởng thẳng.
Em đã là được bài toán ngược: tức là từ đường cong nội suy ra được đường thẳng và đỉnh của nó ( tức là giải quyết bài toán thuận) nhưng cv khá thủ công và mất nhiều thời gian. Yêu cầu chính của lisp là: khi click chọn cung tròn sẽ tự vẽ ra đường thẳng đã bị xóa
Em đang thử viết lisp nhưng chưa khả quan lắm nên nhờ mọi người giúp đỡ!
Rất cám ơn và mong sự hợp tác của mọi ngươi !
Thân !

  • 0

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 12 July 2010 - 08:46 PM

Chào các anh chị. Dạo này mới đi làm nên yêu cầu cv cần tiến độ nên cần làm gấp 1 cv có nội sung như sau:
+ Bài toán thuận: Cho hai đường thẳng tiếp xúc nhau và dùng lệnh Fillet bo 2 đường thẳng bằng cung tròn R=300m.
+ Bài toán ngược như sau: Bây giờ đã xóa đường thẳng và chỉ còn lại cung tròn bk R=300m và 2 tiếp điểm của đưởng thẳng.
Em đã là được bài toán ngược: tức là từ đường cong nội suy ra được đường thẳng và đỉnh của nó ( tức là giải quyết bài toán thuận) nhưng cv khá thủ công và mất nhiều thời gian. Yêu cầu chính của lisp là: khi click chọn cung tròn sẽ tự vẽ ra đường thẳng đã bị xóa
Em đang thử viết lisp nhưng chưa khả quan lắm nên nhờ mọi người giúp đỡ!
Rất cám ơn và mong sự hợp tác của mọi ngươi !
Thân !


Bài toán khá hay, sau đây là lời giải.
Lệnh là LFA (Line From Arc)
(defun c:lfa( / e tt p r st ed hp d oldos)
(setq e (car (entsel "\nHay pick vao Arc: "))
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".ucs" "w")
(command ".line" (setq p1 (polar p st r)) (polar p1 (- st hp) d) "")
(command ".line" (setq p2 (polar p ed r)) (polar p2 (+ ed hp) d) "")
(command ".ucs" "p")
(setvar "osmode" oldos)
)

  • 1

#3 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 12 July 2010 - 09:11 PM

Chính xác thì bài toán thuận là: cho 2 đường thẳng cắt nhau...
Và bải toán nghịch cũng ko nên đưa cái R =300 vào làm gĩ :D
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#4 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 12 July 2010 - 10:46 PM

Bài toán khá hay, sau đây là lời giải.
Lệnh là LFA (Line From Arc)

(defun c:lfa( / e tt p r st ed hp d oldos)
(setq e (car (entsel "\nHay pick vao Arc: "))
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".ucs" "w")
(command ".line" (setq p1 (polar p st r)) (polar p1 (- st hp) d) "")
(command ".line" (setq p2 (polar p ed r)) (polar p2 (+ ed hp) d) "")
(command ".ucs" "p")
(setvar "osmode" oldos)
)

Trước hết rất cám ơn sự giúp đỡ nhiệt tình của anh Nguyen Hoanh. Chỉ có điều tôi muốn chỉnh sửa lại lisp 1 chút như thế này: " Lisp bác viết đã thoả mãn yêu cầu, bác có thể viết thêm cho em đoạn mã lệnh để 2 đường thẳng đó cắt nhau tại điểm đỉnh được không?" - Như vậy là sẽ hoàn chỉnh ( em đỡ phải ex rồi trim 2 đường kéo dài để ra giao ở đỉnh ). Thú thực em chỉ dùng VBA nhiều, chứ lisp ko quen ngôn ngữ lắm. Cám ơn bác !
Và đặc biệt thêm 1 trường hợp khá hay: " Nếu trong trường hợp có 2 cung tròn nối tiếp và đã tạo dạng đối tượng Polyline, khi đó việc nội suy theo lệnh LFA không dùng được mà phải phá bỏ đối tượng thành 2 cung " - Liệu có cách giải quyết cho trường hợp này ?
  • 0

#5 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 12 July 2010 - 11:38 PM

Trước hết rất cám ơn sự giúp đỡ nhiệt tình của anh Nguyen Hoanh. Chỉ có điều tôi muốn chỉnh sửa lại lisp 1 chút như thế này: " Lisp bác viết đã thoả mãn yêu cầu, bác có thể viết thêm cho em đoạn mã lệnh để 2 đường thẳng đó cắt nhau tại điểm đỉnh được không?" - Như vậy là sẽ hoàn chỉnh ( em đỡ phải ex rồi trim 2 đường kéo dài để ra giao ở đỉnh ). Thú thực em chỉ dùng VBA nhiều, chứ lisp ko quen ngôn ngữ lắm. Cám ơn bác !
Và đặc biệt thêm 1 trường hợp khá hay: " Nếu trong trường hợp có 2 cung tròn nối tiếp và đã tạo dạng đối tượng Polyline, khi đó việc nội suy theo lệnh LFA không dùng được mà phải phá bỏ đối tượng thành 2 cung " - Liệu có cách giải quyết cho trường hợp này ?

Đoạn mã để 2 đường thẳng đó giao nhau 1 điểm dưới đây. Lệnh là LFA1 là một cải tiến của lệnh LFA như trên.
(defun c:lfa1(  / e tt p r st ed hp d oldos)
(setq e (car (entsel "\nHay pick vao Arc: "))
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
p1 (polar p st r)
p2 (polar p ed r)
p1a (polar p1 (- st hp) d)
p2a (polar p2 (+ ed hp) d)
pg (inters p1 p1a p2 p2a nil)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".ucs" "w")
(command ".line" pg p1a "")
(command ".line" pg p2a "")
(command ".ucs" "p")
(setvar "osmode" oldos)
)


Về việc 2 arc nối tiếp thành pline (có 3 đỉnh), bạn hãy upload 1 file ví dụ của bạn lên. Tôi hình dung được điều bạn mô tả nhưng không chắc đúng ý bạn về cách nối tiếp 2 arch thành 1 pline. Theo cách tôi nghĩ, việc convert pline này thành arc khá đơn giản, chỉ là vẽ 1 arc mới đi qua 3 đỉnh của pline và xóa pline cũ đi. Nếu đã quen VBA bạn cũng có thể tự thực hiện việc này.

Rất mong bạn sẽ chia sẻ VBA cùng mọi người.
  • 1

#6 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 13 July 2010 - 12:03 AM

Về việc 2 arc nối tiếp thành pline (có 3 đỉnh), bạn hãy upload 1 file ví dụ của bạn lên. Tôi hình dung được điều bạn mô tả nhưng không chắc đúng ý bạn về cách nối tiếp 2 arch thành 1 pline. Theo cách tôi nghĩ, việc convert pline này thành arc khá đơn giản, chỉ là vẽ 1 arc mới đi qua 3 đỉnh của pline và xóa pline cũ đi. Nếu đã quen VBA bạn cũng có thể tự thực hiện việc này.

Rất mong bạn sẽ chia sẻ VBA cùng mọi người.

Sau đây là file đính kèm: File gồm 2 cung arc đã được nối liền lại => Bài toán là dựng lại 3 đường thẳng như trong ví dụ. Nhờ bác Hoanh giúp nốt ?
File : Tải
  • 0

#7 doanduyhung

doanduyhung

    biết vẽ spline

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

Đã gửi 13 July 2010 - 07:54 AM

Sau đây là file đính kèm: File gồm 2 cung arc đã được nối liền lại => Bài toán là dựng lại 3 đường thẳng như trong ví dụ. Nhờ bác Hoanh giúp nốt ?
File : Tải


Đạo code một chút :D

(defun c:noicungnhieuarc (/)
(setq chon (entsel "\nHay pick vao Polyline Chua Nhieu Arc: "))
(command "Explode" chon "")
(setq nhomdoituong (ssget "p"))
(setq i 0)
(repeat (sslength nhomdoituong)
(setq madoituong (cdr (assoc 0 (entget (ssname nhomdoituong i)))))
(if (= madoituong "ARC")
(progn
(setq e (ssname nhomdoituong i)
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
p1 (polar p st r)
p2 (polar p ed r)
p1a (polar p1 (- st hp) d)
p2a (polar p2 (+ ed hp) d)
pg (inters p1 p1a p2 p2a nil)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".ucs" "w")
(command ".line" pg p1a "")
(command "break" p1 p1 "")
(command "ERASE" (entlast) "")
(command ".line" pg p2a "")
(command "break" p2 p2 "")
(command "ERASE" (entlast) "")
(command ".ucs" "p")
(setvar "osmode" oldos)
)
)
(setq i (+ i 1))
)
(command "pedit" "m" nhomdoituong "" "y" "j" "" "")
)
  • 1

#8 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 13 July 2010 - 05:21 PM

Đã thử nhưng ko làm được ?
Bạn đã test code chưa ?
  • 0

#9 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 13 July 2010 - 05:52 PM

Sau đây là file đính kèm: File gồm 2 cung arc đã được nối liền lại => Bài toán là dựng lại 3 đường thẳng như trong ví dụ. Nhờ bác Hoanh giúp nốt ?
File : Tải

Thì ra bài toán của bạn là vậy, nếu từ đầu bạn post file mẫu lên thì đỡ phải viết nhiều lần.

lệnh lfa2 là bài toán làm với các cung tròn (bạn có thể chọn nhiều cung tròn một lúc)
(defun c:lfa2 (/ e tt p r st ed hp d oldos)
(setq ss (ssget '((0 . "ARC")))
es (ss2ent ss)
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command ".ucs" "w")
(foreach e es
(setq
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
p1 (polar p st r)
p2 (polar p ed r)
p1a (polar p1 (- st hp) d)
p2a (polar p2 (+ ed hp) d)
pg (inters p1 p1a p2 p2a nil)
)
(command ".line" pg p1 "")
(command ".line" pg p2 "")
)
(command ".ucs" "p")
(setvar "osmode" oldos)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)


Bạn có thể explode pline ra thành nhiều arc để sử dụng lệnh lfa2.
  • 2

#10 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 13 July 2010 - 08:40 PM

Bạn có thể explode pline ra thành nhiều arc để sử dụng lệnh lfa2.


Cám ơn bác rất nhiều!
Chỉ có điều : "Có thể thêm đoạn mã lệnh nối các đường thẳng thành Pline không bác. Vì nếu em dùng lệnh PE rất mất thời gian."
Bác giúp em cho hoàn thiện ?
Thân ! Chúc bác luôn khoẻ
  • 0

#11 doanduyhung

doanduyhung

    biết vẽ spline

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

Đã gửi 14 July 2010 - 08:16 AM

Đã thử nhưng ko làm được ?
Bạn đã test code chưa ?

Đã test
Link fix
http://www.cadviet.c...ungnhieuarc.rar
  • 0

#12 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

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

Đã gửi 14 July 2010 - 09:34 AM

Thì ra bài toán của bạn là vậy, nếu từ đầu bạn post file mẫu lên thì đỡ phải viết nhiều lần.
lệnh lfa2 là bài toán làm với các cung tròn (bạn có thể chọn nhiều cung tròn một lúc)
Bạn có thể explode pline ra thành nhiều arc để sử dụng lệnh lfa2.

Quả thực bài toán này rất hay. Và lisp bác làm rất oki. Nhưng em chỉ muốn hỏi thêm: "Mình thay đổi tham số gì trong code mà khi ta pick vào các ARC cùng layer1 thì lệnh lfa2 chỉ thực hiện cho các cung này, còn các cung ARC khác không cùng thuộc layer1 thì lệnh lfa2 không thực hiện "
Cám ơn bác !
  • 0

#13 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 14 July 2010 - 10:09 AM

Cám ơn bác rất nhiều!
Chỉ có điều : "Có thể thêm đoạn mã lệnh nối các đường thẳng thành Pline không bác. Vì nếu em dùng lệnh PE rất mất thời gian."
Bác giúp em cho hoàn thiện ?
Thân ! Chúc bác luôn khoẻ

Mặc dù bạn doanduyhung đã post rồi, nhưng code sau ngắn hơn.
VD biến d=10*r là thừa
Vì không có thời gian nên dùng explode tuy không an toàn nhưng chính xác hơn.
(defun C:RestoreTangent (/ i om ss el gr sa st ed p p1 p2 v)
(while (not ss)
(setq ss (ssget ":S" '((0 . "LWPOLYLINE") )) ))
(command ".copy" ss "" '(0.0 0.0 ) "@")
(command ".explode" (entlast))
(setq gr (ssget "p") i -1 sa (ssadd) v (/ pi 2) om (getvar "osmode"))
(setvar "osmode" 0)(command ".ucs" "w")

(repeat (sslength gr)
(setq i (1+ i) el (entget (ssname gr i)))
(if (= (cdr (assoc 0 el)) "ARC")
(progn
(setq
p (cdr (assoc 10 el))r (cdr (assoc 40 el))
st (cdr (assoc 50 el))ed (cdr (assoc 51 el))
p1 (polar p st r) p2 (polar p ed r)
p (inters p1 (polar p1 (- st v) r) p2 (polar p2 (+ ed v) r) nil)
)
(command ".line" p p1 "")(ssadd (entlast) sa)
(command ".line" p p2 "")(ssadd (entlast) sa)
)))

(command ".erase" gr "")
(command ".pedit" "m" sa "" "y" "j" "" "")
(command ".ucs" "p")(setvar "osmode" om)(princ)
)

  • 1

#14 VUVUZELA

VUVUZELA

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 210 Bài viết
Điểm đánh giá: 97 (tàm tạm)

Đã gửi 14 July 2010 - 10:29 AM

Mạn phép thay đổi 1 tý cho em nó nhé bác Nguyen Hoanh
Cho có 1 tý tự động
(defun c:lfa3 (/ e tt p r st ed hp d oldos)
(setq ss (ssget '((0 . "ARC")))
es (ss2ent ss)
)
(setq oldos (getvar "osmode"))
(setq color (getvar "cecolor"))
(setvar "osmode" 0)
(command ".ucs" "w")

;;;Man phep thay doi 1 ty nhe bac Nguyen Hoanh
(if (/= es nil)
(progn
(setq tmp (nth 0 es))
(setq
es1 (ssget "X"
(list
(assoc 8 (entget tmp))
(assoc 0 (entget tmp))
)
)
)
(setq es (ss2ent es1))
(setvar "cecolor" "6")
)
)
;;;;
(foreach e es
(setq
tt (entget e)
p (cdr (assoc 10 tt))
r (cdr (assoc 40 tt))
st (cdr (assoc 50 tt))
ed (cdr (assoc 51 tt))
hp (/ pi 2.0)
d (* 10 r)
p1 (polar p st r)
p2 (polar p ed r)
p1a (polar p1 (- st hp) d)
p2a (polar p2 (+ ed hp) d)
pg (inters p1 p1a p2 p2a nil)
)
(command ".line" pg p1 "")
(command ".line" pg p2 "")
)
(command ".ucs" "p")
(setvar "osmode" oldos)
(setvar "cecolor" color)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

  • 0

Hệ thống Liên Kết, Thiết Kế Tự Động

ttps://www.facebook...etThietKeTuDong