Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
NguyenNgocSon

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

Các bài được khuyến nghị

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 !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nguyen Hoanh    4.524
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)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thaistreetz    515

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 ?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nguyen Hoanh    4.524
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.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
doanduyhung    40
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" "" "")

)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Nguyen Hoanh    4.524
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.

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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ẻ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ndtnv    397
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)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
VUVUZELA    98

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×