Đến nội dung


Hình ảnh
- - - - -

[Nhờ viết lisp] vẽ độ dốc


  • Please log in to reply
6 replies to this topic

#1 thanhlam03xt

thanhlam03xt

    biết vẽ pline

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

Đã gửi 02 February 2012 - 02:00 PM

Mình có cái lisp đánh bóng độ dốc tìm được trên diễn đàn nhưng chưa phù hợp với công việc của mình nên hôm nay nhờ các cao thủ trên diễn đàn giúp đỡ
lisp:
(defun c:dbdd(/ eLine curve1 curve2 i j len1 len2 tmp)
(vl-load-com)
(or #dist (setq #dist 10)) ; 10 = Khoang cach mac dinh
(setq #dist (cond ((getdist (strcat "\nKhoang cach bat dau <" (vl-princ-to-string #dist) " > :")))(#dist)))
(or #inc (setq #inc 1.2)) ;
(setq #inc (cond ((getdist (strcat "\nGia so <" (vl-princ-to-string #inc) " > :")))(#inc)))
(defun eLine (p1 p2 / p2 col)(entmake (list (cons 0 "LINE")(cons 10 p1) (cons 11 p2)(cons 62 8) (cons 8 "0"))))
;;Doan duoi nay khong can de y
(If
(and
(setq curve1 (car(entsel "\nPath curve 1 :")))
(setq curve2 (car(entsel "\nPath curve 2 :")))
(wcmatch (cdadr (entget curve1)) "*LINE,ARC")
(wcmatch (cdadr (entget curve2)) "*LINE,ARC")
(eLine (vlax-curve-getStartPoint curve1) (vlax-curve-getStartPoint curve2))
(setq tmp 0 i 0 len1 (vlax-curve-getDistAtParam curve1 (vlax-curve-getEndParam curve1)) len2 (vlax-curve-getDistAtParam curve2 (vlax-curve-getEndParam curve2)))
)
(while (<= (setq tmp (+ (* #dist (expt #inc (setq i (1+ i))))tmp)) len1)
(eLine (vlax-curve-getPointAtDist curve1 tmp) (vlax-curve-getPointAtDist curve2 tmp))
)
)
)

Mong các cao thủ co thể chính sửa giúp để có thề thực hiện được các thao tác như file đính kèm:
http://www.mediafire...t4scpdcd60icq1k
  • 0
Sống trên đời cần có một tấm lòng.....

#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 02 February 2012 - 02:58 PM

Mình có cái lisp đánh bóng độ dốc tìm được trên diễn đàn nhưng chưa phù hợp với công việc của mình nên hôm nay nhờ các cao thủ trên diễn đàn giúp đỡ
lisp:

Mong các cao thủ co thể chính sửa giúp để có thề thực hiện được các thao tác như file đính kèm:
http://www.mediafire...t4scpdcd60icq1k

Hề hề hề,
Bạn hãy tham khảo cái này coi đã gần đúng ý bạn chưa nhé.


(defun c:kbg (/ e1 e2 a a1 e k p pd pc dis B)
(vl-load-com)
(command "undo" "be")
(command "ucs" "w")
(setq e1 (car(entsel "\n Chon duong bien thu nhat"))
e2 (car(entsel "\n Chon duong bien thu hai"))
e (car (entsel "\n Chon duong ke chuan"))
;;; a (getreal "\n Nhap khoang cach chuan: ")
k (Getreal "\n Nhap he so khoang cach: ")
p (getpoint "\n Chon huong rai duong ke bong")
dis (distance p (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) p T))
b 0
)
(if (not a1) (setq a1 (getreal "\n Nhap khoang cach chuan: ")))
(if (/= a1 nil)
(setq a a1)
(setq a 10))
(setq la (getstring t "\n Nhap ten layer: "))
(if (= (tblsearch "layer" la) nil)
(command "layer" "m" la "c" 8 "" "")
)
(setvar "clayer" la)
(command "change" e "" "p" "la" la "")
(while (and (< b dis) (> a 0.01))
(command "offset" a e p "")
(setq e (entlast)
a (* k a)
b (+ b a)
pd (vlax-curve-getstartpoint e)
pc (vlax-curve-getendpoint e)
d1 (vlax-curve-getclosestpointto e1 pd T)
)
(if (setq p1 (acet-geom-intersectwith e e1 0))
(command "trim" e1 "" pd "")
(command "extend" e1 "" pd "")
)

(if (setq p2 (acet-geom-intersectwith e e2 0))
(command "trim" e2 "" pc "")
(command "extend" e2 "" pc "")
)
)
;;;(command "ucs" "p")
(command "undo" "e")
(princ)
)
Chúc bạn vui.
  • 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 thanhlam03xt

thanhlam03xt

    biết vẽ pline

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

Đã gửi 02 February 2012 - 04:40 PM

Hề hề hề,
Bạn hãy tham khảo cái này coi đã gần đúng ý bạn chưa nhé.



(defun c:kbg (/ e1 e2 a a1 e k p pd pc dis B)
(vl-load-com)
(command "undo" "be")
(command "ucs" "w")
(setq e1 (car(entsel "\n Chon duong bien thu nhat"))
e2 (car(entsel "\n Chon duong bien thu hai"))
e (car (entsel "\n Chon duong ke chuan"))
;;; a (getreal "\n Nhap khoang cach chuan: ")
k (Getreal "\n Nhap he so khoang cach: ")
p (getpoint "\n Chon huong rai duong ke bong")
dis (distance p (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) p T))
b 0
)
(if (not a1) (setq a1 (getreal "\n Nhap khoang cach chuan: ")))
(if (/= a1 nil)
(setq a a1)
(setq a 10))
(setq la (getstring t "\n Nhap ten layer: "))
(if (= (tblsearch "layer" la) nil)
(command "layer" "m" la "c" 8 "" "")
)
(setvar "clayer" la)
(command "change" e "" "p" "la" la "")
(while (and (< b dis) (> a 0.01))
(command "offset" a e p "")
(setq e (entlast)
a (* k a)
b (+ b a)
pd (vlax-curve-getstartpoint e)
pc (vlax-curve-getendpoint e)
d1 (vlax-curve-getclosestpointto e1 pd T)
)
(if (setq p1 (acet-geom-intersectwith e e1 0))
(command "trim" e1 "" pd "")
(command "extend" e1 "" pd "")
)

(if (setq p2 (acet-geom-intersectwith e e2 0))
(command "trim" e2 "" pc "")
(command "extend" e2 "" pc "")
)
)
;;;(command "ucs" "p")
(command "undo" "e")
(princ)
)
Chúc bạn vui.


cảm ơn Bác Bình. Bác có thể sửa giúp em tí nữa dduwwocj không. Bác bỏ qua thao tác nhập tên layer mà cho nó nhận layer hiện hành. và Bác xem giúp em sao khi thực hiện lênh 2 biên giới hạn không được và khi rải thì nó chỉ rải được 7 đường.
  • 0
Sống trên đời cần có một tấm lòng.....

#4 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 02 February 2012 - 05:54 PM


cảm ơn Bác Bình. Bác có thể sửa giúp em tí nữa dduwwocj không. Bác bỏ qua thao tác nhập tên layer mà cho nó nhận layer hiện hành. và Bác xem giúp em sao khi thực hiện lênh 2 biên giới hạn không được và khi rải thì nó chỉ rải được 7 đường.

Hề hề hề,
Chịu chết, không thể làm gì nếu bạn lười đến mức không thể post cái file bản vẽ thể hiện cái chỗ chưa đúng yêu cầu của bạn cũng như thể hiện rõ cái kết quả bạn cần lên. Mọi người không ai có thể rảnh rỗi để ngồi đoán ý tưởng của bạn được.
Đây là lần cuối cùng mình nhắc bạn điều này. Từ lần sau mình sẽ không trả lời những điều bạn hỏi mà vẫn mắc lỗi tương tự thế này.
Hề hề hề,
Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 thanhlam03xt

thanhlam03xt

    biết vẽ pline

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

Đã gửi 03 February 2012 - 08:03 AM

Hề hề hề,
Chịu chết, không thể làm gì nếu bạn lười đến mức không thể post cái file bản vẽ thể hiện cái chỗ chưa đúng yêu cầu của bạn cũng như thể hiện rõ cái kết quả bạn cần lên. Mọi người không ai có thể rảnh rỗi để ngồi đoán ý tưởng của bạn được.
Đây là lần cuối cùng mình nhắc bạn điều này. Từ lần sau mình sẽ không trả lời những điều bạn hỏi mà vẫn mắc lỗi tương tự thế này.
Hề hề hề,
Chúc bạn vui.


Sorry Bác Bình, em sẽ rút kinh nghiệm lần sau cảm ơn Bác đã nhắc nhở. Nhờ Bác giúp đỡ em thêm tí nữa nhé:
http://www.mediafire...1a985a40l14t29f
Nhờ Bác xem giúp đỡ em!
  • 0
Sống trên đời cần có một tấm lòng.....

#6 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 03 February 2012 - 02:09 PM


Sorry Bác Bình, em sẽ rút kinh nghiệm lần sau cảm ơn Bác đã nhắc nhở. Nhờ Bác giúp đỡ em thêm tí nữa nhé:
http://www.mediafire...1a985a40l14t29f
Nhờ Bác xem giúp đỡ em!

Hề hề hề,
Vậy có phải tốt hơn không???
Sở dĩ bạn có kết quả như trên vì bạn chưa hiểu hết nội dung của lisp mà thôi. Do lisp này viết theo yêu cầu của một người khác nên trình tữ thao tác không hoàn toàn giống như ý bạn. Tuy nhiên nó vẫn hoàn toàn có thể sử dụng cho yêu cầu của bạn nếu bạn lưu ý những điểm như sau: (điều này đã được đề cập trong topic của chủ thớt trước, bạn hãy tìm lại để đọc nhé)
1/- Khi chọn đường biên thứ nhất bạn phải chọn đúng về phía diểm bắt đầu củ đường chuẩn và đường biên thứ hai nằm về phía điểm cuối của đường kẻ chuẩn. Do trật tự chọn này của bạn chưa đúng nên các đường kẻ bon1ng (hay kẻ dốc như bạn gọ) sẽ bị hoặc là không cắt hoặc là cắt sai. Trong trường hợp đó đơn giản là bạn chỉ cần uondo và chọn lại đường biên theo thứ tự ngược lại là Ok.
2/- Khi chọn hướng kẻ bóng, thực chất điểm chọn sẽ là điểm giới hạn của các đường kẻ bóng thay cho việc chọn đường giới hạn của bạn. Vì thế khi điểm chọn của bạn nằm bên trong khung thì lisp chỉ kẻ các đường kẻ bóng tới khi đường kẻ tiếp theo sẽ nằm ngoài điểm giới hạn này, còn nếu điểm chọn của bạn nằm ngoài khung đủ lớn thì các đường kẻ bóng sẽ được kẻ vươt ra bên ngoài khung cho tới khi đạt tới điểm giớ hạn đó. (trong trường hợp này các đường kẻ nằm ngoài khung sẽ có chung độ dài như đường kẻ bóng cuối cùng trong khung). Với yêu cầu như bạn thì đơng giản chỉ là khi lisp yêu cầu chọn hướng rải đường kẻ bóng bạn chỉ cần pick một điểm bất kỳ nằm trên cái đường giớ hạn của bạn là Ok, và như vậy bạn cũng chả cần tới việc chọn đường giới hạn làm chi nữa.
3/- Yêu cầu bỏ qua bước nhập tên lớp mình đã bổ sung theo cách nếu bạn muốn bỏ qua thì khi lisp hỏi bạn cứ nhấn enter. Sở dĩ mình vẫn để bước lisp hỏi này là để nhỡ có lúc bạn lại cần đưa các dường kẻ bóng này vào một lớp riêng biệt nào đó như bạn chủ thớt trước thì có cái mà dùng.
4/- Việc các đường kẻ bóng cần phải là màu 8 mình cũng đã bổ sung vào lisp. Nhưng việc chọn chiều dày nét vẽ là 0.9 như bạn yêu cầu thì mình chưa làm. Việc này bạn có thể tự làm được với việc sử dụng lệnh change - Thickness
5/- Về trình tự thao tác nhập dữ liệu cho lisp có thể khác với cái trình tự bạn yêu cầu, nhưng mình nghĩ bạn hoàn toàn có thể thay đổi lại cho phù hợp được nên mình cũng không sửa nữa do lười và cũng không dư nhiều thời gian. Vậy mong bạn thông cảm.

Đây là cái lisp trước mình đã chỉnh sửa chút xíu cho phù hợp với những điều bạn yêu cầu nhưng không hoàn toàn đúng như đã giải thích ở trên. Bạn hãy dùng thử và lưu ý các điểm 1,2 ở trên xem đã trúng với cái bạn cần chưa nhé.



(defun c:kbg (/ e1 e2 a a1 e k p pd pc dis B)
(vl-load-com)
(command "undo" "be")
(command "ucs" "w")
(setq e1 (car(entsel "\n Chon duong bien thu nhat"))
e2 (car(entsel "\n Chon duong bien thu hai"))
e (car (entsel "\n Chon duong ke chuan"))
;;; a (getreal "\n Nhap khoang cach chuan: ")
k (Getreal "\n Nhap he so khoang cach: ")
p (getpoint "\n Chon huong rai duong ke bong")
dis (distance p (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) p T))
b 0
)
(if (not a1) (setq a1 (getreal "\n Nhap khoang cach chuan: ")))
(if (/= a1 nil)
(setq a a1)
(setq a 10))
(setq la (getstring t "\n Nhap ten layer: "))
(if (and (/= la nil) (/= la " "))
(progn
(if (= (tblsearch "layer" la) nil)
(command "layer" "m" la "c" 8 "" "")
)
;;;;;(setvar "clayer" la)
(command "change" e "" "p" "la" la "")
)
)

(while (and (< b dis) (> a 0.01))
(command "offset" a e p "")
(setq e (entlast)
a (* k a)
b (+ b a)
pd (vlax-curve-getstartpoint e)
pc (vlax-curve-getendpoint e)
d1 (vlax-curve-getclosestpointto e1 pd T)
)
(if (setq p1 (acet-geom-intersectwith e e1 0))
(command "trim" e1 "" pd "")
(command "extend" e1 "" pd "")
)

(if (setq p2 (acet-geom-intersectwith e e2 0))
(command "trim" e2 "" pc "")
(command "extend" e2 "" pc "")
)
(command "change" e "" "p" "c" "8" "")
)
;;;(command "ucs" "p")
(command "undo" "e")
(princ)
)

Chúc bạn vui khi tham gia diễn đàn và mong bạn lưu ý các quy định chung của diễn đàn bạn nhé.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#7 thanhlam03xt

thanhlam03xt

    biết vẽ pline

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

Đã gửi 03 February 2012 - 02:26 PM

Hề hề hề,
Vậy có phải tốt hơn không???
Sở dĩ bạn có kết quả như trên vì bạn chưa hiểu hết nội dung của lisp mà thôi. Do lisp này viết theo yêu cầu của một người khác nên trình tữ thao tác không hoàn toàn giống như ý bạn. Tuy nhiên nó vẫn hoàn toàn có thể sử dụng cho yêu cầu của bạn nếu bạn lưu ý những điểm như sau: (điều này đã được đề cập trong topic của chủ thớt trước, bạn hãy tìm lại để đọc nhé)
1/- Khi chọn đường biên thứ nhất bạn phải chọn đúng về phía diểm bắt đầu củ đường chuẩn và đường biên thứ hai nằm về phía điểm cuối của đường kẻ chuẩn. Do trật tự chọn này của bạn chưa đúng nên các đường kẻ bon1ng (hay kẻ dốc như bạn gọ) sẽ bị hoặc là không cắt hoặc là cắt sai. Trong trường hợp đó đơn giản là bạn chỉ cần uondo và chọn lại đường biên theo thứ tự ngược lại là Ok.
2/- Khi chọn hướng kẻ bóng, thực chất điểm chọn sẽ là điểm giới hạn của các đường kẻ bóng thay cho việc chọn đường giới hạn của bạn. Vì thế khi điểm chọn của bạn nằm bên trong khung thì lisp chỉ kẻ các đường kẻ bóng tới khi đường kẻ tiếp theo sẽ nằm ngoài điểm giới hạn này, còn nếu điểm chọn của bạn nằm ngoài khung đủ lớn thì các đường kẻ bóng sẽ được kẻ vươt ra bên ngoài khung cho tới khi đạt tới điểm giớ hạn đó. (trong trường hợp này các đường kẻ nằm ngoài khung sẽ có chung độ dài như đường kẻ bóng cuối cùng trong khung). Với yêu cầu như bạn thì đơng giản chỉ là khi lisp yêu cầu chọn hướng rải đường kẻ bóng bạn chỉ cần pick một điểm bất kỳ nằm trên cái đường giớ hạn của bạn là Ok, và như vậy bạn cũng chả cần tới việc chọn đường giới hạn làm chi nữa.
3/- Yêu cầu bỏ qua bước nhập tên lớp mình đã bổ sung theo cách nếu bạn muốn bỏ qua thì khi lisp hỏi bạn cứ nhấn enter. Sở dĩ mình vẫn để bước lisp hỏi này là để nhỡ có lúc bạn lại cần đưa các dường kẻ bóng này vào một lớp riêng biệt nào đó như bạn chủ thớt trước thì có cái mà dùng.
4/- Việc các đường kẻ bóng cần phải là màu 8 mình cũng đã bổ sung vào lisp. Nhưng việc chọn chiều dày nét vẽ là 0.9 như bạn yêu cầu thì mình chưa làm. Việc này bạn có thể tự làm được với việc sử dụng lệnh change - Thickness
5/- Về trình tự thao tác nhập dữ liệu cho lisp có thể khác với cái trình tự bạn yêu cầu, nhưng mình nghĩ bạn hoàn toàn có thể thay đổi lại cho phù hợp được nên mình cũng không sửa nữa do lười và cũng không dư nhiều thời gian. Vậy mong bạn thông cảm.

Đây là cái lisp trước mình đã chỉnh sửa chút xíu cho phù hợp với những điều bạn yêu cầu nhưng không hoàn toàn đúng như đã giải thích ở trên. Bạn hãy dùng thử và lưu ý các điểm 1,2 ở trên xem đã trúng với cái bạn cần chưa nhé.



(defun c:kbg (/ e1 e2 a a1 e k p pd pc dis B)
(vl-load-com)
(command "undo" "be")
(command "ucs" "w")
(setq e1 (car(entsel "n Chon duong bien thu nhat"))
e2 (car(entsel "n Chon duong bien thu hai"))
e (car (entsel "n Chon duong ke chuan"))
;;; a (getreal "n Nhap khoang cach chuan: ")
k (Getreal "n Nhap he so khoang cach: ")
p (getpoint "n Chon huong rai duong ke bong")
dis (distance p (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) p T))
b 0
)
(if (not a1) (setq a1 (getreal "n Nhap khoang cach chuan: ")))
(if (/= a1 nil)
(setq a a1)
(setq a 10))
(setq la (getstring t "n Nhap ten layer: "))
(if (and (/= la nil) (/= la " "))
(progn
(if (= (tblsearch "layer" la) nil)
(command "layer" "m" la "c" 8 "" "")
)
;;;;;(setvar "clayer" la)
(command "change" e "" "p" "la" la "")
)
)

(while (and (< b dis) (> a 0.01))
(command "offset" a e p "")
(setq e (entlast)
a (* k a)
b (+ b a)
pd (vlax-curve-getstartpoint e)
pc (vlax-curve-getendpoint e)
d1 (vlax-curve-getclosestpointto e1 pd T)
)
(if (setq p1 (acet-geom-intersectwith e e1 0))
(command "trim" e1 "" pd "")
(command "extend" e1 "" pd "")
)

(if (setq p2 (acet-geom-intersectwith e e2 0))
(command "trim" e2 "" pc "")
(command "extend" e2 "" pc "")
)
(command "change" e "" "p" "c" "8" "")
)
;;;(command "ucs" "p")
(command "undo" "e")
(princ)
)

Chúc bạn vui khi tham gia diễn đàn và mong bạn lưu ý các quy định chung của diễn đàn bạn nhé.

Cảm ơn Bác Bình rất nhiều em đã thực hiện được công việc của mình. Có gì sai sót mang Bác Bình thong cảm! thanks!!!!!
  • 0
Sống trên đời cần có một tấm lòng.....