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

Nhờ Thêm Vòng Lặp Vào Lisp

Bởi taipham , trong AutoLisp

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

taipham    5

taipham
Đã đăng

Em đang tập tành autolisp, không biết thêm vòng lặp while vào chỗ nào để lisp sau khi nhập chiều dài đoạn mút thì chọn liên liếp các line, hoặc chọn liên tiếp các pline, hoặc chọn liên tiếp 2 điểm để vẽ.

Nhờ anh chị trong diễn đàn giúp đỡ. Xin cảm ơn!

(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (setq dt (entsel "\nChon duong thang: "))
  (if
    (= dt nil)
	(progn
	(setq p1 (getpoint "\nChon diem dau")
	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai"))))
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (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

tien2005    241

tien2005
Đã đăng

Bạn cần phải khử biến sau khi kết thúc lệnh, thêm các kiểm tra để tránh lỗi, rút ngắn câu lệnh, lisp sau chỉ thêm vòng lặp thêm yêu cầu

(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (while
    (or	(setq dt (entsel "\nChon duong thang: "))
	(and (setq p1 (getpoint "\nChon diem dau"))
	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
	)
    )
  (if dt
;;;    (= dt nil)
;;;	(progn
;;;	(setq p1 (getpoint "\nChon diem dau")
;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai")))
    )
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  );while
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (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

taipham    5

taipham
Đã đăng

 

Bạn cần phải khử biến sau khi kết thúc lệnh, thêm các kiểm tra để tránh lỗi, rút ngắn câu lệnh, lisp sau chỉ thêm vòng lặp thêm yêu cầu

(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (while
    (or	(setq dt (entsel "\nChon duong thang: "))
	(and (setq p1 (getpoint "\nChon diem dau"))
	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
	)
    )
  (if dt
;;;    (= dt nil)
;;;	(progn
;;;	(setq p1 (getpoint "\nChon diem dau")
;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai")))
    )
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  );while
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (princ))

Cảm ơn anh nhé! 

Ý em muốn là khi đã chọn vẽ từ 2 điểm thì chỉ lặp lại pick chọn 2 điểm liên tục hoặc khi đã chọn "line,pline" thì select line liên tục.

như vậy có được không anh!

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

tien2005    241

tien2005
Đã đăng 
(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (setq chk t)
  (while
    (or	(and chk
	  (setq dt (entsel "\nChon duong thang: "))
	    )
	(and (setq p1 (getpoint "\nChon diem dau"))
	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
	     (not (setq chk nil))
	)
    )
  (if dt
;;;    (= dt nil)
;;;	(progn
;;;	(setq p1 (getpoint "\nChon diem dau")
;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai")))
    )
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  );while
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (princ))

dùng tạm cái này

  • 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

taipham    5

taipham
Đã đăng 
(defun C:VTT()
(command "undo" "be")
  (setq cmd (getvar "cmdecho")
	osm (getvar "osmode"))
  (setvar "cmdecho" 0)
  (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
  (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
  (setq chk t)
  (while
    (or	(and chk
	  (setq dt (entsel "\nChon duong thang: "))
	    )
	(and (setq p1 (getpoint "\nChon diem dau"))
	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
	     (not (setq chk nil))
	)
    )
  (if dt
;;;    (= dt nil)
;;;	(progn
;;;	(setq p1 (getpoint "\nChon diem dau")
;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
    (if
      (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
      (progn
	(setq pt (acet-geom-vertex-list (car dt))
	   p1 (car pt)
	   p2 (last pt)))
      (if
	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
	(progn
        (setq dt (car dt)
	   dt (entget dt)
	   p1 (cdr (assoc 10 dt))
	   p2 (cdr (assoc 11 dt))))
	(princ "\nChon sai")))
    )
  (setvar "osmode" 0)
  (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
	p4 (polar p2 (angle p1 p2) mut))
  (command ".mline" p3 p4 "")
  (setvar "osmode" osm)
  );while
  (setvar "cmdecho" cmd)
  (command "undo" "e")
  (princ))

dùng tạm cái này

 

Oke, hay quá, cảm ơn anh nhiều nhé!

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

lanvientkh    14

lanvientkh
Đã đăng

(defun C:XY( / p1 p2)
(setq
    p1 (getpoint "\nFirst point:")
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
(princ)
)


Mình muốn thêm dòng lặp và chỉ kết thúc khi enter mà tìm hiểu chưa làm được, bạn hỗ trợ dùm

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
22 phút trước, lanvientkh đã nói:

(defun C:XY( / p1 p2)
(setq
    p1 (getpoint "\nFirst point:")
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
(princ)
)


Mình muốn thêm dòng lặp và chỉ kết thúc khi enter mà tìm hiểu chưa làm được, bạn hỗ trợ dùm 

(defun C:XY( / p1 p2)
(setq
    p1 (getpoint "\nFirst point:")
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
(while (setq
    p1 (getpoint "\nFirst point:"))
(setq
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
)
(princ)
)

Sửa lại cho bạn nhé

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

Bee    154

Bee
Đã đăng
3 phút trước, Doan Van Ha đã nói:

Thừa đoạn trên rồi

Chuẩn bác Hạ. ^_^

While luôn cho rồi. 

  • Like 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

lanvientkh    14

lanvientkh
Đã đăng
5 giờ trước, huunhantvxdts đã nói: 

(defun C:XY( / p1 p2)
(setq
    p1 (getpoint "\nFirst point:")
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
(while (setq
    p1 (getpoint "\nFirst point:"))
(setq
    p2 (getpoint p1 "\nNext point:")
)
(setvar "dimtad" 1)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
)
(princ)
)

Sửa lại cho bạn nhé

Cảm ơn bạn, nhưng khi dùng báo lỗi, bạn kiểm tra dùm mình với nhé

First point:; error: bad argument type: point

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
5 giờ trước, lanvientkh đã nói:

Cảm ơn bạn, nhưng khi dùng báo lỗi, bạn kiểm tra dùm mình với nhé

First point:; error: bad argument type: point

Không hiểu sao máy bạn lại bị lỗi, mình kiểm tra trên máy mình chạy ok nhé

viết lại lisp bỏ phần dư thừa 

(defun C:XY( / p1 p2)
(setq dimtadold (getvar "dimtad"))
(setvar "dimtad" 1)
(while (setq
    p1 (getpoint "\nFirst point:"))
(setq
    p2 (getpoint p1 "\nNext point:")
)
(command "leader" p1 p2 "a" (strcat "X="(rtos (cadr p1)) "\\P" (strcat "Y="(rtos (car p1)))) "")
)
(setvar "dimtad" dimtadold)
(princ)
)

 

  • Like 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

lanvientkh    14

lanvientkh
Đã đăng

Lisp hiện nay tọa độ  khi xuất ra là trục Y nằm trên trục X nằm dưới có thể chỉnh lại để khi xuất ra trục X nằm trên trục Y nằm dưới theo lệnh của CAD là tuyệt, thanks all bạn nhiều

  • Vote giảm 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

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
×