Chuyển đến nội dung
Diễn đàn CADViet
ketxu

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

Bởi ketxu , trong AutoLisp

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

ketxu    2.984

ketxu
Đã đăng

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é ^^

Untitled.jpg

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

  • Vote tăng 10

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

hdg2318    31

hdg2318
Đã đăng

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ẻ!

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

hugo75    4

hugo75
Đã đăng

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é ^^

Untitled.jpg

(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.

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

ketxu    2.984

ketxu
Đã đăng

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

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

hugo75    4

hugo75
Đã đăng

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é ^^

Untitled.jpg

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.

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

ketxu    2.984

ketxu
Đã đăng

Ô 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 ^^

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

hugo75    4

hugo75
Đã đăng

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.

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

duy782006    1.544

duy782006
Đã đăng

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

  • 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

duy782006    1.544

duy782006
Đã đăng

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.

  • 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

ketxu    2.984

ketxu
Đã đăng

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

  • 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

duy782006    1.544

duy782006
Đã đăng

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

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

tuandat5804    0

tuandat5804
Đã đăng

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!

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

nguoihung_3    0

nguoihung_3
Đã đăng

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é ^^

Untitled.jpg

(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?

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

VThanhgtvt    1

VThanhgtvt
Đã đăng

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á!!!

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

Trai Xây Dựng    1

Trai Xây Dựng
Đã đăng
Vào lúc 15/7/2011 tại 00:15, ketxu đã nói:

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

có cách nào để khai báo đường kính các vòng tròn tại các điểm dừng k 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

dinhsyha    0

dinhsyha
Đã đăng
Vào lúc 25/6/2018 tại 15:20, batitus đã nói:

Nếu không cần mũi tên ở cuối thì làm thế nào các cụ ( chị cần mũi tên đầu thôi). 

 

thế thì dùng luôn leader cũng được mà 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

zutum    0

zutum
Đã đăng

hi các bạn,

Các bạn có thể giúp mình cải tiến cái lisp này vẽ mũi tên 2 đầu ( vẽ đường thẳng hay đường xiên ) chỉ cần pick 2 điểm nó tự vẽ đường thẳng có 2 đầu mũi tên và ở giữa đoạn thẳng đó có thể nhập text ghi số cho sản phẩm. Vì mình hay gióng các đường kích thước cơ bản dài, rộng cao cho khách thấy trên hình 3d nên cần cái này làm cho nhanh ( gióng sơ bên layout ). thanks mấy bạn nhiều

image.thumb.png.a9bce23b79dcdd6b30e5f5b07c173d27.png

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
Về Đầu Trang AutoLisp
×