Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Lisp vẽ Pline mũi tên 2 đầu


  • Please log in to reply
15 replies to this topic

#1 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 30 June 2011 - 10:36 AM

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm nhé ^^
Hình đã gửi
(defun c:sline (/ loop p1 p2)   
(grtext -1 "Free from Cadviet.com @Ketxu")
(if (not asize) (setq asize 1))
(if (not PThk) (setq PThk 0.01))
(defun GETR (val msg / tm)
(setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
(cond ((= (type tm) 'REAL) (eval tm))
((= tm nil) (eval val))
(t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
(defun loop ()
(cond ((setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : ")) (command p2)
(setq p0 p1) (setq p1 p2) (loop))
( t (command "u" (polar p1 (angle p1 p0) asize)
"w" (/ asize 3) 0.0 p1 ""))))
(setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
(setq PThk (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
(setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
(command "pline" p1 "w" 0.0 0.0)
(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
(command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
"w" PThk PThk p2)
(setq p1 p2)
(loop)
(eval "Done")
)

  • 10

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


#2 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 30 June 2011 - 04:40 PM

code này ketxu viết rất hay :)
  • 0

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


#3 hdg2318

hdg2318

    biết lệnh mirror

  • Members
  • PipPipPip
  • 158 Bài viết
Điểm đánh giá: 31 (tàm tạm)

Đã gửi 30 June 2011 - 10:19 PM

trước cũng tìm mỏi mắt không thấy ở đâu có cái lisp này, đành dùng cách thủ công.
lấy 2 điểm rồi dùng dòng lệnh

(command "leader" p1 p2 ^C)
(command "leader" p2 p1 ^C)

tuy không đa dạng về kiểu và không linh động như của ketxu, nhưng dùng tạm cũng được, hì.
Thanks ketxu đã chia sẻ!
  • 0

Có 2 cách để nhìn đời:
1 là : coi như chẳng có gì là huyền diệu
2 là : coi như mọi điều đều huyền diệu


Click here


#4 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 13 July 2011 - 11:07 AM

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm nhé ^^
Hình đã gửi

(defun c:sline (/ loop p1 p2)   
(grtext -1 "Free from Cadviet.com @Ketxu")
(if (not asize) (setq asize 1))
(if (not PThk) (setq PThk 0.01))
(defun GETR (val msg / tm)
(setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
(cond ((= (type tm) 'REAL) (eval tm))
((= tm nil) (eval val))
(t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
(defun loop ()
(cond ((setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : ")) (command p2)
(setq p0 p1) (setq p1 p2) (loop))
( t (command "u" (polar p1 (angle p1 p0) asize)
"w" (/ asize 3) 0.0 p1 ""))))
(setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
(setq PThk (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
(setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
(command "pline" p1 "w" 0.0 0.0)
(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
(command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
"w" PThk PThk p2)
(setq p1 p2)
(loop)
(eval "Done")
)

Nhờ bác thêm giùm chức năng nếu các điểm tiếp theo nằm trên cùng đường thẳng thì tại mỗi điểm khi ta click thì sẽ vẽ 1 vòng tròn đường kính bằng 50.
Còn các điểm tiếp theo không nằm trên đường thẳng thì không có vòng tròn này.Cảm ơn bác nhiều.
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 July 2011 - 03:11 PM

Nhờ bác thêm giùm chức năng nếu các điểm tiếp theo nằm trên cùng đường thẳng thì tại mỗi điểm khi ta click thì sẽ vẽ 1 vòng tròn đường kính bằng 50.
Còn các điểm tiếp theo không nằm trên đường thẳng thì không có vòng tròn này.Cảm ơn bác nhiều.

Chịu không hiểu được ý bạn diễn tả "nếu các điểm tiếp theo nằm trên cùng đường thẳng" là như thế nào ^^
  • 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


#6 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 13 July 2011 - 03:33 PM

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm nhé ^^
Hình đã gửi

Vẽ 2 đầu mũi tên của đoạn thẳng.giống như hình thứ 2 phía trên đó bạn.Còn hình 1 và 3 không nằm cùng trên 1 đoạn thẳng.
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 July 2011 - 03:50 PM

Ô hay, trên cùng 1 đường thẳng nhưng bạn k nói là theo phương nào ý. Nếu theo tất cả các phương thì cũng là 1 vấn đề lớn với trình độ cùi bắp của mìn rù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


#8 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 13 July 2011 - 05:34 PM

Nếu theo phương X và Y không được thì bạn sửa giùm mình theo 1 phương,còn phương kia mình dùng lệnh RO để xoay lại cũng được.Thanks.
  • 0

#9 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 14 July 2011 - 04:02 PM

Ô hay, trên cùng 1 đường thẳng nhưng bạn k nói là theo phương nào ý. Nếu theo tất cả các phương thì cũng là 1 vấn đề lớn với trình độ cùi bắp của mìn rùi ^^

Theo mình cứ xét theo cặp 3 điểm cứ thẳng hàng thì cho cái hình tròn vào điểm thứ 3.
-Mình thử đc như này nhưng đoạn vẽ mũi tên vào cuối đường đang bí.

(defun c:plmt()
(command "undo" "be")

(vl-load-com)

(if (null dlmt)(setq dlmt "10"))
(if (null dlvt)(setq dlvt "5"))
(Setq temp T)
(While temp
(setq po1 (strcat "\ndo lon Mui ten la(" dlmt ")/ Do lon Vong tron (" dlvt ")<Chon diem xuat phat>: "))
(Initget "m M v V")
(setq str (getpoint po1))
(Cond
((= str "m") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "M") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "V") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
((= str "v") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
(Progn
(Setq po1 str)
(setq temp nil)
)
)
)

(setq dlmtt (atof dlmt))

(setq po2 (getpoint po1"\n Second point :"))
(if (null (equal po1 po2)) (command "pline" po1 "w" 0 (/ dlmtt 2) (polar po1 (angle po1 po2) dlmtt) "w" 0 0 po2 ""))
(setq La (entlast))

(while (null (equal po1 po2))
(setq po3 (getpoint po2"\n Second point :"))
(command "pline" po2 po3 "")
(command "pedit" "m" "L" La "" "j" "0" "")
(setq La (entlast))
(cond
((/= (angle po1 po2) (angle po2 po3)))
((= (angle po1 po2) (angle po2 po3))
(command ".circle" po3 dlvt))
)
(setq po1 po2)
(setq po2 po3)
)

(command "undo" "end")
(princ)
)

  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#10 hugo75

hugo75

    biết vẽ polygon

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

Đã gửi 14 July 2011 - 09:22 PM

Không có cao thủ nào gỡ bí giùm bác DUY để hoàn thành lisp cho e được sao?
  • 0

#11 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 14 July 2011 - 10:37 PM

Không có cao thủ nào gỡ bí giùm bác DUY để hoàn thành lisp cho e được sao?

Xong rồi đây.

(defun c:plmt()
(command "undo" "be")

(vl-load-com)

(if (null dlmt)(setq dlmt "10"))
(if (null dlvt)(setq dlvt "2"))
(Setq temp T)
(While temp
(setq po1 (strcat "\ndo lon Mui ten la(" dlmt ")/ Do lon Vong tron (" dlvt ")<Chon diem xuat phat>: "))
(Initget "m M v V")
(setq str (getpoint po1))
(Cond
((= str "m") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "M") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "V") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
((= str "v") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
(Progn
(Setq po1 str)
(setq temp nil)
)
)
)

(setq dlmtt (atof dlmt))

(setq po2 (getpoint po1"\n Chon diem tiep theo :"))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po1 "w" 0 (/ dlmtt 2) (polar po1 (angle po1 po2) dlmtt) "w" 0 0 po2 "")
(setvar "osmode" luubatdiem)
(setq La (entlast))

(while (setq po3 (getpoint po2"\nChon diem tiep theo <Enter de ket thuc>: "))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po2 po3 "")
(setvar "osmode" luubatdiem)
(command "pedit" "m" "L" La "" "j" "0" "")
(setq La (entlast))
(cond
((/= (angle po1 po2) (angle po2 po3)))
((= (angle po1 po2) (angle po2 po3))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".circle" po3 dlvt))
(setvar "osmode" luubatdiem)
)
(setq po1 po2)
(setq po2 po3)
)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po2 "w" 0 (/ dlmtt 2) (polar po2 (angle po2 po1) dlmtt) "")
(setvar "osmode" luubatdiem)
(command "pedit" "m" "L" La "" "j" "0" "")
(command "undo" "end")
(princ)
)

Còn đang bị độ rộng pline sau khi chạy lệnh đang khác độ rộng hiện hành trước đó. Hiện ko có sách bên cạnh nên ko nhờ biến này lưu tên gì nên chưa có trả lại đc sẽ cập nhật sau.
  • 2

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#12 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 July 2011 - 12:15 AM

Vẽ 2 đầu mũi tên của đoạn thẳng.giống như hình thứ 2 phía trên đó bạn.Còn hình 1 và 3 không nằm cùng trên 1 đoạn thẳng.

Bác Duy đã giả nhời bạn rồi, tuy nhiên mình cũng bonus thêm cái update của mình với vài function để tái sử dụng ^^. Lisp sẽ vẽ vòng tròn cho bạn nếu tất cả các điểm nằm trên đường thẳng (mọi phương)
(defun c:sline (/ loop p1 p2 lstPnt)   
(grtext -1 "Free from Cadviet.com @Ketxu")
(setq lstPnt '())
(if (not asize) (setq asize 1))
(if (not PThk) (setq PThk 0.01))
(defun GETR (val msg / tm)
(setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
(cond ((= (type tm) 'REAL) (eval tm))
((= tm nil) (eval val))
(t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
(defun loop ()
(cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command p2)
(setq p0 p1) (setq p1 p2) (loop))
( t (command "u" (polar p1 (angle p1 p0) asize)
"w" (/ asize 3) 0.0 p1 ""))))
(setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
(setq PThk (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
(setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
(setq lstPnt (append (list p1) lstPnt))
(command "pline" p1 "w" 0.0 0.0)
(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
(setq lstPnt (append (list p2) lstPnt))
(command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
"w" PThk PThk p2)
(setq p1 p2)
(loop)
(if (ST:Geo-ListLinear lstPnt)
(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
)
(eval "Done")
)
(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
(
(lambda ( a b c )
(or
(equal (+ a B) c fuzz)
(equal (+ b c) a fuzz)
(equal (+ c a) b fuzz)
)
)
(distance p1 p2) (distance p2 p3) (distance p1 p3)
)
)
(defun ST:Geo-ListLinear (lst / tmp)
(setq i 2)
(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
(T (while (and (< i (1- (length lst)))
(setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
tmp
)
)
)
tmp
)
(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))

@bác Duy : Theo em thấy thì nếu bác xét 3 điểm thuộc 1 đường thẳng bằng cách so góc thế kia sẽ bị thiếu trường hợp điểm thứ 3 nằm giữa hoặc bên trái điểm 1,2 . và có chút bất tiện nhỏ khi điểm thứ 3 rơi đúng vào điểm dừng vẽ (vòng tròn trùng mũi tên), hoặc đường Pline bẻ hướng ^^
  • 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


#13 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 15 July 2011 - 09:41 AM

@bác Duy : Theo em thấy thì nếu bác xét 3 điểm thuộc 1 đường thẳng bằng cách so góc thế kia sẽ bị thiếu trường hợp điểm thứ 3 nằm giữa hoặc bên trái điểm 1,2 . và có chút bất tiện nhỏ khi điểm thứ 3 rơi đúng vào điểm dừng vẽ (vòng tròn trùng mũi tên), hoặc đường Pline bẻ hướng ^^

-Trường hợp điểm thứ 3 chạy ngược lại mình nghỉ không nên, nếu người dùng vẽ trùng như thế mình cũng ko chiều ý họ làm gì.
-Đã xoá vòng tròn nếu là điểm dừng vẽ và điểm bẻ hướng.
@hugo: mình đã thêm vòng tròn vào điểm thứ 2 luôn rồi đó.
Do đã viết nên mình cũng cố theo tí :D cho có sinh động bác ketxu nhé
(defun c:plmt(/ tinhtrangtron)
(command "undo" "be")

(vl-load-com)

(if (null dlmt)(setq dlmt "10"))
(if (null dlvt)(setq dlvt "2"))
(Setq temp T)
(While temp
(setq po1 (strcat "\ndo lon Mui ten la(" dlmt ")/ Do lon Vong tron (" dlvt ")<Chon diem xuat phat>: "))
(Initget "m M v V")
(setq str (getpoint po1))
(Cond
((= str "m") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "M") (setq dlmt (getstring (strcat"\nDo lon mui ten <" dlmt "> :"))))
((= str "V") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
((= str "v") (setq dlvt (getstring (strcat"\nDo lon vong tron <" dlvt "> :"))))
(Progn
(Setq po1 str)
(setq temp nil)
)
)
)

(setq dlmtt (atof dlmt))

(setq po2 (getpoint po1"\n Chon diem tiep theo :"))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po1 "w" 0 (/ dlmtt 2) (polar po1 (angle po1 po2) dlmtt) "w" 0 0 po2 "")
(setvar "osmode" luubatdiem)
(setq La (entlast))
(setq sht 0)

(while (setq po3 (getpoint po2"\nChon diem tiep theo <Enter de ket thuc>: "))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po2 po3 "")
(setvar "osmode" luubatdiem)
(command "pedit" "m" "L" La "" "j" "0" "")
(setq La (entlast))
(cond
((/= (angle po1 po2) (angle po2 po3))
(setq tinhtrangtron "ko")
(if (/= sht 0)(command "erase" vtr ""))
(setq sht 0))
((= (angle po1 po2) (angle po2 po3))
(setq sht (+ 1 sht))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".circle" po3 dlvt)
(setq vtr (entlast))
(if (= sht 1)(command ".circle" po2 dlvt))
(setq tinhtrangtron "co")
(setvar "osmode" luubatdiem)
)
)
(setq po1 po2)
(setq po2 po3)
)

(if (= tinhtrangtron "co")(command "erase" vtr ""))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "pline" po2 "w" 0 (/ dlmtt 2) (polar po2 (angle po2 po1) dlmtt) "")
(setvar "osmode" luubatdiem)
(command "pedit" "m" "L" La "" "j" "0" "")
(command "undo" "end")
(princ)
)

  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#14 tuandat5804

tuandat5804

    biết pan

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

Đã gửi 13 March 2012 - 10:50 PM

topic này lâu quá rồi nhưng mình có 1 yêu cầu nhỏ mong các bạn để ý giúp.
mình muốn vẽ 1 đường pline mỗi điềm đầu đều có đầu mũi tên. việc này mình cần trong bản vẽ kỹ thuật chỉ hướng thoát. mong các bạn giup cho!
  • 0

#15 nguoihung_3

nguoihung_3

    biết zoom

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

Đã gửi 05 July 2012 - 07:44 AM

Lâu lâu rồi thấy có bác nào hỏi cái này, hôm nay e lục trong máy thấy có, post lên cho bác nào cần dùng.
P/S : tối thiểu vào 3 điểm nhé ^^
Hình đã gửi

(defun c:sline (/ loop p1 p2)  
(grtext -1 "Free from Cadviet.com @Ketxu")
(if (not asize) (setq asize 1))
(if (not PThk) (setq PThk 0.01))
(defun GETR (val msg / tm)
(setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
(cond ((= (type tm) 'REAL) (eval tm))
((= tm nil) (eval val))
(t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
(defun loop ()
(cond ((setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : ")) (command p2)
(setq p0 p1) (setq p1 p2) (loop))
( t (command "u" (polar p1 (angle p1 p0) asize)
"w" (/ asize 3) 0.0 p1 ""))))
(setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
(setq PThk (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
(setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
(command "pline" p1 "w" 0.0 0.0)
(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
(command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize)
"w" PThk PThk p2)
(setq p1 p2)
(loop)
(eval "Done")
)

Bác có thể chèn thêm dòng lệnh khai báo bề rộng điểm đầu mũi tên,chiều dài mũi tên,và bề rộng điểm cuối mũi tên sau đó mới khai báo bề dày của PL được không bác?
  • 0

#16 VThanhgtvt

VThanhgtvt

    biết vẽ circle

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

Đã gửi 05 July 2012 - 04:26 PM

Bác có thể chèn thêm dòng lệnh khai báo bề rộng điểm đầu mũi tên,chiều dài mũi tên,và bề rộng điểm cuối mũi tên sau đó mới khai báo bề dày của PL được không bác?

Em thấy lisp của bác chủ top cũng rất tốt rùi. Nếu có thêm chức năng như bác nói thì tốt quá!!!
  • 0