Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
17 replies to this topic

#1 Thanh Thủy

Thanh Thủy

    Chưa sử dụng CAD

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

Đã gửi 11 August 2014 - 09:16 AM

(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.c...caodotntn_1.lsp

http://www.cadviet.c...3942_bvtn_1.dwg


  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 11 August 2014 - 09:23 AM

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


  • 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


#3 Thanh Thủy

Thanh Thủy

    Chưa sử dụng CAD

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

Đã gửi 11 August 2014 - 09:32 AM

Mình làm rồi đó bạn, nhưng mà vậy thì không up file cad lên được ah


  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 11 August 2014 - 10:02 AM

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


  • 1

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


#5 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 13 August 2014 - 08:54 AM

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

  • 0

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 13 August 2014 - 09:03 AM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 13 August 2014 - 09:29 AM

Ở đâ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.


  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 13 August 2014 - 10:01 AM

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]: ")))


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 13 August 2014 - 10:07 AM

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.


  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 13 August 2014 - 10:21 AM

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

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 13 August 2014 - 11:08 AM

Nhiều chuyện tí

Bác Ha cho hỏi đoạn code trên thì khi nào thỏa mãn (= pt "U")


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#12 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 13 August 2014 - 11:19 AM

Khi bạn nhập "U" hoặc "u". Câu hỏi này có ý chi đây?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#13 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 13 August 2014 - 11:24 AM

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


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#14 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 13 August 2014 - 11:27 AM

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?


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#15 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 13 August 2014 - 11:30 AM

đã p/s là đừng mắng mà :D :D :D

Cảm ơn vì đã mót được 1 củ :D


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#16 Thanh Thủy

Thanh Thủy

    Chưa sử dụng CAD

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

Đã gửi 14 August 2014 - 03:27 PM

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.


  • 0

#17 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 August 2014 - 05:58 PM

@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.c...pl/#entry160425

 

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


  • 1

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


#18 Thanh Thủy

Thanh Thủy

    Chưa sử dụng CAD

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

Đã gửi 15 August 2014 - 11:12 AM

được rồi, thank các bro nhiều :)


  • 0