Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
leejang

Đoạn CODE củ chuối ??? Sửa mãi vẫn dở hơi, Đành nhờ mấy bác Pro dùng tuyệt chiêu ???

Bởi leejang , trong AutoLisp

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

leejang    5

leejang
Đã đăng

Cái Lisp tính diện tích của em, ở những bản vẽ bình thường thì chạy ngon lành nhưng gặp những bản vẽ " củ chuối" là sau vài lần chạy là nó tự mất cái bắt điểm OSNAP(Tắt F3). Em rất khó chịu, bác pro nào chỉnh giúp em với !!!

CODE

;;=============== Dien tich ==============

(defun c:R(/ dtl dtcon pt1 pt2 ss et oslast vsize)

(command "dimzin" "0")

(Setq CVAR (Getvar "CMDECHO"))

(Setvar "CMDECHO" 0)

(print)

(if (= tle nil) (progn

(setq tle (getreal "Ty le ban ve 1:X , X=?: "))

(setq ntl (/ 1 tle))

; (setq ntl 1)

(setq tl2 (* ntl ntl))

)

)

(setq dtl 0)

(setq ss (ssadd))

(setq oslast (getvar "OSMODE"))

(command "osnap" "")

(print)

(print)

(setq pt1 (getpoint "\n Chon diem ben trong hinh : "))

(while (/= pt1 nil)

(command "-boundary" pt1 "")

(setq et (entlast))

(ssadd et ss)

(command "area" "e" "last")

; (setq vsize (/ (getvar "VIEWSIZE") tl1))

; (command "hatch" "ANSI31" vsize "0" "last" "")

(setq et (entlast))

(ssadd et ss)

(setq dtcon (/ (getvar "AREA") tl2))

(setq dtl (+ dtcon dtl))

(prompt (strcat "\n Dien tich hinh vua chon=" (rtos dtcon 2 3)))

(print)

(print)

(setq pt1 (getpoint "\nPick internal point : "))

)

(command "setvar" "OSMODE" oslast)

(command "erase" ss "")

(setq ss nil)

(command "redraw")

; (setq dtl (/ dtl 2))

; (print)

(prompt (strcat "\n Dien tich = " (rtos dtl 2 4)))

(print)

 

; (setq pt2 (getpoint "\n Chon text ghi chu dien tich: "))

; (if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))

; (command "text" pt2 "0" (strcat (rtos dtl 2 2) " m2"))

; (command "text" pt2 "2" "0" (strcat (rtos dtl 2 3) "m2" ))

; );if

 

;; ====== nua dien tich=======

(setq xxx (/ dtl 2))

(print)

(prompt (strcat "\n 1/2 Dien tich = " (rtos xxx 2 4)))

(print)

 

;;ghi chu dien tich ================

(setq giatri (entget (car (entsel "\n Chon Text dien dien tich: "))))

(setq gia (assoc 1 giatri))

(setq nt1 (cons 1 (rtos dtl )))

(setq giatri (subst nt1 gia giatri))

(entmod giatri)

(princ)

(Command "")

(Setvar "CMDECHO" CVAR)

);defun ARR

(princ)

 

; Hide & Show

(DEFUN C:LT () (COMMAND "LTSCALE"))

(defun c:an (/ SSet Count Elem)

 

(defun Dxf (Id Obj)

(cdr (assoc Id (entget Obj)))

);end Dxf

 

(prompt "\nChon doi tuong an di: ")

(cond

((setq SSet (ssget))

(repeat (setq Count (sslength SSet))

(setq Count (1- COunt)

Elem (ssname SSet Count))

(if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))

(if (Dxf 60 Elem)

(entmod (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem)))

(entmod (append (entget Elem) (list '(60 . 1))))

)

(prompt "\nKhong the an,doi tuong da bi khoa !. ")

);end if

);end repeat

)

);end cond

(princ)

);end c:InVis

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

q288    166

q288
Đã đăng
Cái Lisp tính diện tích của em, ở những bản vẽ bình thường thì chạy ngon lành nhưng gặp những bản vẽ " củ chuối" là sau vài lần chạy là nó tự mất cái bắt điểm OSNAP(Tắt F3). Em rất khó chịu, bác pro nào chỉnh giúp em với !!!

 

Chẳng phải tại bản vẽ củ chuối đâu mà do khi bạn chọn điểm bên trong mà cái boundary

nằm ngoài vùng nhìn sẽ phát sinh lỗi, khi đó nếu bạn nhấn esc sẽ thoát ra khỏi chương trình và mất osnap.

Cái này trước đây cũng có người hỏi rồi.

Mình sửa lisp như sau đây, bạn test thử xem sao, cứ esc thoải mái.

Mình cũng ko chắc sau khi sửa lisp có giải quyết đc vấn đề hay ko.

 

(defun c:R (/ dtl dtcon pt1 pt2 ss et vsize)
 (setq temp *error* *error* myerror)
 (defun myerror(msg)
   (setvar "OSMODE" oslast)
   (setq *error* temp)
 )
 (command "dimzin" "0")
 (Setq CVAR (Getvar "CMDECHO"))
 (Setvar "CMDECHO" 0)
 (print)
 (if (= tle nil)
   (progn
     (setq tle (getreal "Ty le ban ve 1:X , X=?: "))
     (setq ntl (/ 1 tle))				
     (setq tl2 (* ntl ntl))
   )
 )
 (setq dtl 0)
 (setq ss (ssadd))
 (setq oslast (getvar "OSMODE"))
 (command "osnap" "")
 (print)
 (print)
 (setq pt1 (getpoint "\n Chon diem ben trong hinh : "))
 (while (/= pt1 nil)
   (command "-boundary" pt1 "")
   (setq et (entlast))
   (ssadd et ss)
   (command "area" "e" "last")				
   (setq et (entlast))
   (ssadd et ss)
   (setq dtcon (/ (getvar "AREA") tl2))
   (setq dtl (+ dtcon dtl))
   (prompt
     (strcat "\n Dien tich hinh vua chon=" (rtos dtcon 2 3))
   )
   (print)
   (print)
   (setq pt1 (getpoint "\nPick internal point : "))
 )
 (command "setvar" "OSMODE" oslast)
 (command "erase" ss "")
 (setq ss nil)
 (command "redraw")
 (prompt (strcat "\n Dien tich = " (rtos dtl 2 4)))
 (print)

 ;; ====== nua dien tich=======
 (setq xxx (/ dtl 2))
 (print)
 (prompt (strcat "\n 1/2 Dien tich = " (rtos xxx 2 4)))
 (print)

 ;;ghi chu dien tich ================
 (setq giatri (entget (car (entsel "\n Chon Text dien dien tich: "))))
 (setq gia (assoc 1 giatri))
 (setq nt1 (cons 1 (rtos dtl)))
 (setq giatri (subst nt1 gia giatri))
 (entmod giatri)
 (princ)
 (Command "")
 (Setvar "CMDECHO" CVAR)
 (setq *error* temp)
)
(princ)

				; Hide & Show 
(DEFUN C:LT () (COMMAND "LTSCALE"))

(defun c:an (/ SSet Count Elem)
 (defun Dxf (Id Obj)
   (cdr (assoc Id (entget Obj)))
 )				;end Dxf
 (prompt "\nChon doi tuong an di: ")
 (cond
   ((setq SSet (ssget))
    (repeat (setq Count (sslength SSet))
      (setq Count (1- COunt)
     Elem  (ssname SSet Count)
      )
      (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
 (if (Dxf 60 Elem)
   (entmod
     (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem))
   )
   (entmod (append (entget Elem) (list '(60 . 1))))
 )
 (prompt "\nKhong the an,doi tuong da bi khoa !. ")
      )				;end if
    )					;end repeat
   )
 )					;end cond
 (princ)
)					;end c:InVis

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

leejang    5

leejang
Đã đăng
Chẳng phải tại bản vẽ củ chuối đâu mà do khi bạn chọn điểm bên trong mà cái boundary

nằm ngoài vùng nhìn sẽ phát sinh lỗi, khi đó nếu bạn nhấn esc sẽ thoát ra khỏi chương trình và mất osnap.

Cái này trước đây cũng có người hỏi rồi.

Mình sửa lisp như sau đây, bạn test thử xem sao, cứ esc thoải mái.

Mình cũng ko chắc sau khi sửa lisp có giải quyết đc vấn đề hay ko.

 

(defun c:R (/ dtl dtcon pt1 pt2 ss et vsize)
 (setq temp *error* *error* myerror)
 (defun myerror(msg)
   (setvar "OSMODE" oslast)
   (setq *error* temp)
 )
 (command "dimzin" "0")
 (Setq CVAR (Getvar "CMDECHO"))
 (Setvar "CMDECHO" 0)
 (print)
 (if (= tle nil)
   (progn
     (setq tle (getreal "Ty le ban ve 1:X , X=?: "))
     (setq ntl (/ 1 tle))				
     (setq tl2 (* ntl ntl))
   )
 )
 (setq dtl 0)
 (setq ss (ssadd))
 (setq oslast (getvar "OSMODE"))
 (command "osnap" "")
 (print)
 (print)
 (setq pt1 (getpoint "\n Chon diem ben trong hinh : "))
 (while (/= pt1 nil)
   (command "-boundary" pt1 "")
   (setq et (entlast))
   (ssadd et ss)
   (command "area" "e" "last")				
   (setq et (entlast))
   (ssadd et ss)
   (setq dtcon (/ (getvar "AREA") tl2))
   (setq dtl (+ dtcon dtl))
   (prompt
     (strcat "\n Dien tich hinh vua chon=" (rtos dtcon 2 3))
   )
   (print)
   (print)
   (setq pt1 (getpoint "\nPick internal point : "))
 )
 (command "setvar" "OSMODE" oslast)
 (command "erase" ss "")
 (setq ss nil)
 (command "redraw")
 (prompt (strcat "\n Dien tich = " (rtos dtl 2 4)))
 (print)

 ;; ====== nua dien tich=======
 (setq xxx (/ dtl 2))
 (print)
 (prompt (strcat "\n 1/2 Dien tich = " (rtos xxx 2 4)))
 (print)

 ;;ghi chu dien tich ================
 (setq giatri (entget (car (entsel "\n Chon Text dien dien tich: "))))
 (setq gia (assoc 1 giatri))
 (setq nt1 (cons 1 (rtos dtl)))
 (setq giatri (subst nt1 gia giatri))
 (entmod giatri)
 (princ)
 (Command "")
 (Setvar "CMDECHO" CVAR)
 (setq *error* temp)
)
(princ)

				; Hide & Show 
(DEFUN C:LT () (COMMAND "LTSCALE"))

(defun c:an (/ SSet Count Elem)
 (defun Dxf (Id Obj)
   (cdr (assoc Id (entget Obj)))
 )				;end Dxf
 (prompt "\nChon doi tuong an di: ")
 (cond
   ((setq SSet (ssget))
    (repeat (setq Count (sslength SSet))
      (setq Count (1- COunt)
     Elem  (ssname SSet Count)
      )
      (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
 (if (Dxf 60 Elem)
   (entmod
     (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem))
   )
   (entmod (append (entget Elem) (list '(60 . 1))))
 )
 (prompt "\nKhong the an,doi tuong da bi khoa !. ")
      )				;end if
    )					;end repeat
   )
 )					;end cond
 (princ)
)					;end c:InVis

kaka, được rùi, cảm ơn bác nhì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

Thaistreetz    539

Thaistreetz
Đã đăng

Liệu q288 có thể sửa đoạn lisp này lại để khi ta pick vào 1 vùng tính diện tích thì lisp sẽ tạo ra một đối tượng boundary khác màu (màu đỏ chẳng hạn) bao quanh vùng tính tiện tích đó. sau khi lisp kết thúc lệnh hay esc kết thúc giữa chừng thì những đối tượng boundary đó sẽ đc xóa đi.

Mục đích của việc này là nhằm đánh dấu những miền ta đã tính diện tích để tránh nhầm lẫn 1 vùng tính diên tích ta pick 2 lần dẫn đến kết quả sai.

 

Và nếu có thể thì ở bước xuất kết quả. nếu không gán vào 1 text có trước thì ta có thêm lựa chọn là pick vào 1 điểm bất kỳ để vẽ kết quả theo text style hiện thời.

 

Mình nghĩ lisp như vậy sẽ là 1 lisp tính diện tích hoàn chỉ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

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×