Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Thanh Thủy

Nhờ sửa lisp đo khoảng cách

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

(defun DXF (code elist)
  (cdr (assoc code elist))
)
 
(defun c:tn (); / DZ pt y ptside ang OT sc1 scale)
  (vl-load-com)
  (setvar "cmdecho" 0)
 
(if (not scale) (setq scale 1))
(setq sc1 (getreal (strcat "\n Cao text <"(rtos scale 2 0)">:")))
(if sc1 (setq scale sc1))
(SETQ OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien <end of> : ") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXF 1 ed)))    
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))
 
(While (/= pt nil)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq y (- (cadr pt) y0 (- H0)))
(setq x (- (car pt) x0))
         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
         ((< x 0) (setq x (rtos (abs x) 2 2)))
         ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
         ((< y 0) (setq y (rtos y 2 2)))
         ((= y 0) (setq y "%%p0.00")))
;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))
 
(if (not (tblsearch "block" "LCD1"))
(progn (command "insert" "C:\\Lisp CAD\\BVTN.dwg" "" "" "" "")
(command "erase" (entlast) "")))
 
( if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "LCD1" pt scale scale "0" x y))
( if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "LCD2" pt scale scale "0" y x))
( if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "LCD3" pt scale scale "0" x y))
( if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "LCD4" pt scale scale "0" y x))
 
(setq pt (getpoint "\nDiem chen: "))
);pro
);while 
(setvar "OSMODE" OSLAST)
(setvar "DIMZIN" DZ)
(setvar "ORTHOMODE" OT))
;---------------------------------------------------------------------------
 
(defun DXF (code elist)
  (cdr (assoc code elist))
)

(defun c:tn (); / DZ pt y ptside ang OT sc1 scale)
  (vl-load-com)
  (setvar "cmdecho" 0)

(if (not scale) (setq scale 1))
(setq sc1 (getreal (strcat "\n Cao text <"(rtos scale 2 0)">:")))
(if sc1 (setq scale sc1))
(SETQ OSLAST (getvar "OSMODE"))
(setq DZ (getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(setq OT (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
(command "osmode" 99)
(setq pt0 (osnap (getpoint "Diem tim TN tu nhien <end of> : ") "end")) (print)
(setq x0 (car pt0) y0 (cadr pt0))
(setq ed (entget (car (entsel "\nChon cao do tim: "))))
(setq H0 (read (DXF 1 ed)))    
(command "osmode" 15359) 
(setq pt (getpoint "\nDiem chen: "))

(While (/= pt nil)
(Progn
(setq ptside (getpoint "\nPhia chen:" pt)
ang (angle pt ptside))
(setq y (- (cadr pt) y0 (- H0)))
(setq x (- (car pt) x0))
         
(cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
         ((< x 0) (setq x (rtos (abs x) 2 2)))
         ((= x 0) (setq x "0.00"))         )
(cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
         ((< y 0) (setq y (rtos y 2 2)))
         ((= y 0) (setq y "%%p0.00")))
;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))

(if (not (tblsearch "block" "LCD1"))
(progn (command "insert" "C:\\Lisp CAD\\BVTN.dwg" "" "" "" "")
(command "erase" (entlast) "")))

( if (AND (>= ang 0) (< ang 1.5708)) (command "INSERT" "LCD1" pt scale scale "0" x y))
( if (AND (>= ang 1.5708) (< ang 3.1416)) (command "INSERT" "LCD2" pt scale scale "0" y x))
( if (AND (>= ang 3.1416) (< ang 4.7124)) (command "INSERT" "LCD3" pt scale scale "0" x y))
( if (AND (>= ang 4.7124) (< ang 6.2832)) (command "INSERT" "LCD4" pt scale scale "0" y x))

(setq pt (getpoint "\nDiem chen: "))
);pro
);while 
(setvar "OSMODE" OSLAST)
(setvar "DIMZIN" DZ)
(setvar "ORTHOMODE" OT))
;---------------------------------------------------------------------------
 

 

Mình có một lisp đo khoảng cách khá hay, mình thường dùng trong đo trắc ngang. Tuy nhiên nó có một số điểm hơi bất tiện mà mình lại ko rành chỉnh sửa nên nhờ anh em giúp đỡ một số vấn đề sau:

       Thứ nhất, chỉnh giùm mình tính năng tự bắt điểm, lisp này cứ tự động tik hết tất cả các chế độ bắt điểm trong osnap, mặc dù mình đã tắt nhưng nó vẫn tự động hiện ra lại, nhờ các bạn chỉnh giùm mình sao cho mình tự điều khiển được chế đôi bắt điêm. Đôi lúc nó hay bắt điểm sai rất bực mình.

      Thứ hai, các bạn chỉnh giùm mình sao cho khi chọn sai điểm nhấn esc nó cho mình chọn lại điểm đó, chứ như trong lisp này khi mình nhấn esc thì phải chọn lại từ đầu.

 Thank tất cả mọi người :), đây là file lisp và file cad của nó

 http://www.cadviet.com/upfiles/3/133942_ghicaodotntn_1.lsp

http://www.cadviet.com/upfiles/3/133942_bvtn_1.dwg

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 sử dụng tag code hình <>  (ngay phía trên chỗ bạn viết bài) để up code file lisp lên nhé, diễn đàn đang lỗi k download từ đó đượ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

1- Bạn tìm tất cả dòng nào có chữ (command "osnap" ...) thì thêm dấu ; vào trước nó để vô hiệu hóa chúng

2- Mình vẫn giữ quan điểm là Esc dùng để thoát lệnh, nên không can thiệp phần catch Esc này

  • 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

Bạn dùng thử cái này. Khi muốn undo thì bấm u, còn tiếp tục thì enter. 

Bạn esc thì nó dứt lệnh và osnap trở về trạng thái trước khi chạy lisp.

 

(defun DXF (code elist)
  (cdr (assoc code elist))
)
 
(defun c:tn (); / DZ pt y ptside ang OT sc1 scale)
  (vl-load-com)
 
  (defun *error* (msg)
    (setq tmp *error*)
    (if OSLAST (setvar "OSMODE" OSLAST))
    (setq *error* tmp)
  )
  (setvar "cmdecho" 0)
  (if (not scale)   (setq scale 1))
  (setq sc1 (getreal (strcat "\n Cao text <" (rtos scale 2 0) ">:")))
  (if sc1   (setq scale sc1)  )
  (SETQ OSLAST (getvar "OSMODE"))
  (setq DZ (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setq OT (getvar "ORTHOMODE"))
  (setvar "ORTHOMODE" 0)
  (command "osmode" 99)
  (setq pt0 (osnap (getpoint "Diem tim TN tu nhien <end of> : ") "end"))
  (print)
  (setq x0 (car pt0)
y0 (cadr pt0)
  )
  (setq ed (entget (car (entsel "\nChon cao do tim: ")))
H0 (read (DXF 1 ed))
  )
  (command "osmode" 15359)  
 
  (While (setq pt (getpoint "\nDiem chen: "))    
    (setq ptside (getpoint pt "\nPhia chen:" )
 ang  (angle pt ptside))
    (setq y (- (cadr pt) y0 (- H0))
 x (- (car pt) x0))
    (cond ((> x 0) (setq x (strcat "" (rtos x 2 2))))
 ((< x 0) (setq x (rtos (abs x) 2 2)))
 ((= x 0) (setq x "0.00"))
  )
    (cond ((> y 0) (setq y (strcat "+" (rtos y 2 2))))
 ((< y 0) (setq y (rtos y 2 2)))
 ((= y 0) (setq y "%%p0.00"))
  )
     ;(setq x (ustr 0 "Khoang cach: " x T))
;(setq y (ustr 0 "Cao do: " y T))     
   (if (not (tblsearch "block" "LCD1"))
     (progn (command "insert" "C:\\Lisp CAD\\BVTN.dwg" "" "" "" "")
            (command "erase" (entlast) ""))
   )
   (if (AND (>= ang 0) (< ang 1.5708))
     (command "INSERT" "LCD1" pt scale scale "0" x y))
    (if (AND (>= ang 1.5708) (< ang 3.1416))
      (command "INSERT" "LCD2" pt scale scale "0" y x))
    (if (AND (>= ang 3.1416) (< ang 4.7124))
      (command "INSERT" "LCD3" pt scale scale "0" x y))
    (if (AND (>= ang 4.7124) (< ang 6.2832))
      (command "INSERT" "LCD4" pt scale scale "0" y x))
 
    (while (= "U" (strcase (getstring "\nEnter = Tiep tuc / U = undo : ")))
      (command "undo" 1)) 
  )
  (setvar "OSMODE" OSLAST)
  (setvar "DIMZIN" DZ)
  (setvar "ORTHOMODE" OT)
)
;---------------------------------------------------------------------------
 

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

@Tot77: nên gộp việc pick điểm chèn và việc undo vào cùng 1 dòng lệnh tương tự như cách làm của cad thì tiện hơn. Ví dụ như lệnh Line chẳng hạ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

Ở đây chỉ thấy có getpoint và insert , sau khi insert xong mới thấy không vừa ý thì undo. Chứ đâu có lệnh nào để undo khi đang getpoint đâu bác Ha.

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

Giả sử bạn dùng như vầy thì khi cần undo việc đã lỡ insert block sẽ thuận tiện hơn việc phải dùng thêm 1 hàm getstring nữa:

(while (and (not (initget "U")) (setq pt (getpoint "\nDiem chen tiep hoac [undo]: ")))

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

Không được bác à, vì khi đã vào getpoint rồi thì bấm U nó chẳng có tác dụng gì nữa.

Bác thử viết lại lisp theo ý của 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

Vào getpoint là 1 point thì nó sẽ insert block.

Vào getpoint là "U" thì nó sẽ undo việc đã insert block trước đó. Tương tự như lện Line thôi. Vào point thì nó vẽ tiếp 1 đoạn line, vào "U" thì nó undo đoạn line vừa vẽ.

(while (and (not (initget "U")) (setq pt (getpoint "\nDiem chen tiep hoac [undo]: ")))

 (if (= pt "U")

  (command "u")

  (command "insert" ...))

(while (and (not (initget "U")) (setq pt (getpoint "\nDiem chen tiep hoac [undo]: ")))
 (if (= pt "U")
  (command "u")
  (command "insert" ...))
  • 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

Lý do:

Dán đoạn code (setq pt (getpoint "\nDiem chen tiep hoac [undo]: ")) vào dòng command

bấm "U" >>>> cad ko nhận

Kiểm tra

!pt >>>>>> nil

 

p/s: có chi sai thì bác chỉ bảo, đừng mắng nhé ! :D :D :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ạn vứt cái (and (not (initget "U") của tôi mất rồi. Tội tui lắm, nếu không cần đoạn đó thì tui bỏ vào mần chi cho rườm?

  • 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

1- Bạn tìm tất cả dòng nào có chữ (command "osnap" ...) thì thêm dấu ; vào trước nó để vô hiệu hóa chúng

2- Mình vẫn giữ quan điểm là Esc dùng để thoát lệnh, nên không can thiệp phần catch Esc này

Mình tìm chả thấy dòng nào có chữ osnap cả chỉ thấy có (command osmode) thô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

@OP : Srr bạn, đúng là thế ^^
@hiepttr : nếu bạn yêu initget thì cũng có thể ngó qua code này , đoạn While. Initget k chỉ có cho riêng getpoint đâu. http://www.cadviet.com/forum/topic/47459-da-xong-lisp-them-dinh-cho-pl/?do=findComment&comment=160425

 

Mà tốt nhất nên ghé help về nó ^^

  • 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

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  

×