Chuyển đến nội dung
Diễn đàn CADViet
Doan Van Ha

[Đã xong] Lisp sử dụng Osnap khi đang dùng hàm Grread

Bởi Doan Van Ha , trong AutoLisp

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

Doan Van Ha    3.201

Doan Van Ha
Đã đăng

Lisp có hàm Grread rất hay. Nhờ nó mà có thể vẽ các đối tượng động khi di chuột trên màn hình. Tuy nhiên, khi sử dụng hàm Grread thì không thể sử dụng Osnap (dù đã đặt trước hay đặt trong lúc di chuột).

Evgeniy Elpanov đã viết 1 hàm rất hay để có thể dùng được Osnap trong khi đang dùng hàm Grread.

Dựa vào đó, tôi viết nên ví dụ mẫu này để các bạn khi cần có thể hiệu chỉnh tùy ý để dùng. Chỉ có nhược điểm nhỏ, đó là: Osnap chỉ có hiệu lực khi đã đặt trước hoặc được chọn từ Toolbar Osnap (chứ chưa thể Osnap bằng Ctrl/Shift+Mouse_right).

Bạn nào có thông tin tốt hơn thì góp cho vui. Coi như 1 món quà Tết 2013. Chúc các bạn hưởng những ngày Tết vui vẻ.

67029_b.gif

;Doan Van Ha - CADViet.com - Ngay 30/12/2012. Thank Evgeniy Elpanov!
;Chuc nang: Vi du mau su dung osnap khi dung ham grread.
;--------------------------------------------------------------------------- MAIN FUNCTIONS
(defun C:HA( / dung p1 code grr pt po)
(setq p1 (getpoint "\nChon diem thu 1: "))
(princ "\nChon diem thu 2:  ")
(while (and (not dung) (setq grr (grread T 4 0) code (car grr) pt (cadr grr)) (not (equal '(2 13) grr)) (not (equal '(2 32) grr)))
 (cond
;----- TH1. Khi re chuot tren man hinh.
  ((equal 5 code)
   (redraw)
   (if (and (< 0 (getvar "osmode") 16384) (setq po (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap pt x)) (list (distance pt o) o x pt))))
  	(get_osmode)))))
(setq po (cdar (vl-sort po (function (lambda (a B) (< (car a) (car B)))))) pt (car po))
(setq po nil))
   (and po (OsMark po))
   (VE_DO_THI_BAC_2_BANG_GRDRAW p1 (/ (getvar "viewsize") 200) 100 pt 2))
;----- TH2: Khi dang thuc hien lenh ma bam chon 1 che do Osnap. Not: (4096 . "_ext") & (8192 . "_par").
  ((= pt 1210) (setvar "osmode" 1)) ((= pt 1211) (setvar "osmode" 2)) ((= pt 1216) (setvar "osmode" 4)) ((= pt 1223) (setvar "osmode" 8))
  ((= pt 1217) (setvar "osmode" 16)) ((= pt 1212) (setvar "osmode" 32)) ((= pt 1222) (setvar "osmode" 64)) ((= pt 1220) (setvar "osmode" 128))
  ((= pt 1218) (setvar "osmode" 256)) ((= pt 1225) (setvar "osmode" 512)) ((= pt 1213) (setvar "osmode" 2048))
;----- TH3. Khi bam chuot vao 1 diem tren man hinh.
  ((equal 3 code) (redraw) (setq dung T))))
(if po (setq pt (car po)) pt)
(VE_DO_THI_BAC_2_BANG_SPLINE p1 (/ (getvar "viewsize") 200) 100 pt)
(princ))
;----- Ve do thi ham bac 2 giua 2 diem bang duong spline.
(defun VE_DO_THI_BAC_2_BANG_SPLINE(q1 kc skc q2 / x1 y1 x2 y2 xb yb gs lst) (setq listpoint '()) (if (and (not (equal q1 q2)) (not (equal (car q1) (car q2)))) (progn (setq x1 (car q1) y1 (cadr q1)) (setq x2 (car q2) y2 (cadr q2)) (setq xb (/ (- y2 y1 (* kc (- (expt x2 2) (expt x1 2)))) (* 2 kc (- x1 x2)))) (setq yb (- y1 (* kc (expt (- x1 xb) 2)))) (setq gs (/ (- x2 x1) skc)) (repeat (+ skc 1) (setq listpoint (reverse (cons (list x1 (+ (* kc (expt (- x1 xb) 2)) yb)) (reverse listpoint)))) (setq x1 (+ gs x1))))) (setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length listpoint)))) (foreach p listpoint (setq lst (append lst (list (cons 11 p))))) (entmake lst))
;----- Ve do thi ham bac 2 giua 2 diem bang ham grdraw.
(defun VE_DO_THI_BAC_2_BANG_GRDRAW(q1 kc skc q2 mau) (if (and (not (equal q1 q2)) (not (equal (car q1) (car q2)))) (progn (setq x1 (car q1) y1 (cadr q1)) (setq x2 (car q2) y2 (cadr q2)) (setq xb (/ (- y2 y1 (* kc (- (expt x2 2) (expt x1 2)))) (* 2 kc (- x1 x2)))) (setq yb (- y1 (* kc (expt (- x1 xb) 2)))) (setq gs (/ (- x2 x1) skc)) (repeat skc (grdraw (list x1 (+ (* kc (expt (- x1 xb) 2)) yb)) (list (+ x1 gs) (+ (* kc (expt (- (+ x1 gs) xb) 2)) yb)) mau) (setq x1 (+ gs x1))))))
;--------------------------------------------------------------------------- SUB FUNCTIONS
;----- T¹o Icon Osnap vµ g¸n vµo ®iÓm po, EX: !po = ((94.4953 17.8586 0.0) "_mid" (94.0427 14.9045 0.0)), lÊy pt = (car po).
(defun osMark (o / s osGrv )
(setq osGrv (osmode-grvecs-lst (vla-get-AutoSnapMarkerColor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
                         (vla-get-AutoSnapMarkerSize (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))))
(setq s (/ (getvar "viewsize") (cadr (getvar "screensize"))) o (cons (trans (car o) 1 3) (cdr o)))
(grvecs (cdr (assoc (cadr o) osGrv)) (list (list s 0. 0. (caar o)) (list 0. s 0. (cadar o)) (list 0. 0. s 0.) (list 0. 0. 0. 1.))))
;----- T¹o list c¸c kiÓu osnap hiÖn ®· ®Æt tr­íc trong b¶n vÏ, EX: (get_osmode) => ("_end" "_nod").
(defun get_osmode nil ; by Evgeniy Elpanov
 (mapcar
   (function cdr)
     (vl-remove-if
       (function (lambda (x) (zerop (logand (getvar "osmode") (car x)))))
       '((1 . "_end") (2 . "_mid") (4 . "_cen") (8 . "_nod") (16 . "_qua") (32 . "_int") (64 . "_ins") (128 . "_per") (256 . "_tan") (512 . "_nea") (2048 . "_app")))))
(defun osmode-grvecs-lst (col ass / -ass ass col) ; By Evgeniy Elpanov (Modified by Lee McDonnell)
 (setq -ass (- ass))
 (list (list "_end"
             col (list -ass -ass) (list -ass  ass)
             col (list (1-  -ass) (1- -ass)) (list (1- -ass) (1+  ass))              
             col (list -ass  ass) (list  ass  ass)
             col (list (1-  -ass) (1+  ass)) (list (1+  ass) (1+  ass))              
             col (list  ass  ass) (list  ass -ass)
             col (list (1+   ass) (1+  ass)) (list (1+  ass) (1- -ass))              
             col (list  ass -ass) (list -ass -ass)
             col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
       (list "_mid"
             col (list -ass -ass) (list    0. ass)
             col (list (1-  -ass) (1- -ass)) (list 0. (1+  ass))
             col (list    0. ass) (list  ass -ass)
             col (list 0. (1+  ass)) (list (1+  ass) (1- -ass))
             col (list  ass -ass) (list -ass -ass)
             col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
       (list "_cen"
             7   (list (* -ass 0.2) 0.)  (list (*  ass 0.2) 0.)
             7   (list  0. (* -ass 0.2)) (list  0.  (*  ass 0.2))
             col (list    -ass   0.) 	(list (* -ass 0.86) (* ass  0.5))
             col (list (* -ass 0.86) (* ass  0.5))  (list (* -ass  0.5) (* ass 0.86))
             col (list (* -ass  0.5) (* ass 0.86))  (list 0. ass)
             col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
             col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
             col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
             col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
             col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
             col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
             col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
             col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
             col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
       (list "_nod"
             col (list -ass -ass)    (list ass ass)
             col (list -ass ass) 	(list ass -ass)
             col (list -ass 0.)      (list (* -ass 0.86) (* ass 0.5))
             col (list (* -ass 0.86) (* ass 0.5))   (list (* -ass 0.5) (* ass 0.86))
             col (list (* -ass 0.5)  (* ass 0.86))  (list 0. ass)
             col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
             col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
             col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
             col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
             col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
             col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
             col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
             col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
             col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
       (list "_qua"
             col (list 0. -ass)   (list -ass 0.)
             col (list 0. (1- -ass))   (list (1- -ass) 0.)
             col (list -ass 0.)   (list 0. ass)
             col (list (1- -ass) 0.)   (list 0. (1+ ass))
             col (list 0. ass)    (list ass 0.)
             col (list 0. (1+ ass))    (list (1+ ass) 0.)
             col (list ass 0.)    (list 0. -ass)
             col (list (1+ ass) 0.)    (list 0. (1- -ass)))
       (list "_int"
             col (list -ass -ass) (list ass ass)
             col (list -ass (1+ -ass)) (list ass (1+ ass))
             col (list (1+ -ass) -ass) (list (1+ ass) ass)
             col (list -ass ass)  (list ass -ass)
             col (list -ass (1+ ass))  (list ass (1+ -ass))
             col (list (1+ -ass) ass)  (list (1+ ass) -ass))
       (list "_ins"
             col (list (* -ass 0.1) (* -ass 0.1)) (list -ass (* -ass 0.1))
             col (list -ass (* -ass 0.1)) (list -ass ass)
             col (list -ass ass) (list (* ass 0.1) ass)
             col (list (* ass 0.1) ass)   (list (* ass 0.1) (* ass 0.1))
             col (list (* ass 0.1) (* ass 0.1))   (list ass (* ass 0.1))
             col (list ass (* ass 0.1))   (list ass -ass)
             col (list ass -ass) (list (* -ass 0.1) -ass)
             col (list (* -ass 0.1) -ass) (list (* -ass 0.1) (* -ass 0.1))
             col (list (1- (* -ass 0.1)) (1- (* -ass 0.1))) (list (1- -ass) (1- (* -ass 0.1)))
             col (list (1- -ass) (1- (* -ass 0.1))) (list (1- -ass) (1+ ass))
             col (list (1- -ass) (1+ ass)) (list (1+ (* ass 0.1)) (1+ ass))
             col (list (1+ (* ass 0.1)) (1+ ass)) (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
             col (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) (list (1+ ass) (1+ (* ass 0.1)))
             col (list (1+ ass) (1+ (* ass 0.1)))   (list (1+ ass) (1- -ass))
             col (list (1+ ass) (1- -ass)) (list (1- (* -ass 0.1)) (1- -ass))
             col (list (1- (* -ass 0.1))   (1- -ass)) (list (1- (* -ass 0.1)) (1- (* -ass 0.1))))
       (list "_tan"
             col (list -ass ass) (list ass ass)
             col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass))
             col (list -ass 0.)  (list (* -ass 0.86) (* ass 0.5))
             col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86))
             col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass)
             col (list 0. ass) (list  (* ass 0.5) (* ass 0.86))
             col (list (* ass 0.5)  (* ass 0.86)) (list (* ass 0.86) (* ass 0.5))
             col (list (* ass 0.86)  (* ass 0.5)) (list ass 0.)
             col (list ass 0.) (list (* ass 0.86) (* -ass 0.5))
             col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86))
             col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass)
             col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86))
             col (list (* -ass 0.5)(* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
             col (list (* -ass 0.86)(* -ass 0.5)) (list -ass 0.))
       (list "_per"
             col (list -ass -ass) (list -ass ass)
             col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
             col (list ass -ass)  (list -ass -ass)
             col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass))
             col (list -ass 0.)   (list 0. 0.)
             col (list -ass -1.)  (list 0. -1.)
             col (list 0. 0.) 	(list 0. -ass)
             col (list -1. 0.)    (list -1. -ass))
       (list "_nea"
             col (list -ass -ass) (list ass ass)
             col (list -ass ass)  (list ass ass)
             col (list (1- -ass)  (1+ ass)) (list (1+ ass) (1+ ass))
             col (list -ass ass)  (list ass -ass)
             col (list ass -ass)  (list -ass -ass)
             col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass)))
       (list "_app"
             col (list -ass -ass) (list ass ass)
             col (list ass -ass)  (list -ass ass)
             col (list -ass -ass) (list -ass ass)
             col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
             col (list -ass ass)  (list ass ass)
             col (list (1- -ass)  (1+ ass))  (list (1+ ass) (1+ ass))
             col (list ass ass)   (list ass -ass)
             col (list (1+ ass)   (1+ ass))  (list (1+ ass) (1- -ass))
             col (list ass -ass)  (list -ass -ass)
             col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass)))))

  • Vote tăng 5

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

Ket nhìn code thấy nó ướm ướm hơi của Lee hơn thì phải , vì nhìn quen lắm hén. Đọc comment thì quả thiệt. Mà bác để biến ASS nghe ngộ ngộ. Like mạnh :* (mà like từ hôm trước rùi, hay lại like típ ^^)

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

KangKung    250

KangKung
Đã đăng

Góp vui với bác Hạ chút.

http://www.cadviet.com/upfiles/3/71162_lisp_ve_hcn_nghiengosnap_ver10_1.lsp

Đây là Lisp vẽ hình chữ nhật có sử dụng grread và osnap để tạo hiệu ứng động cho đẹp mắt. Mục đích của Lisp này là vẽ hình chữnhật không chỉ theo phương đứng hoặc phương nằm ngang mà còn có thể vẽ theo hướng xiên bất kì. Lisp cho phép bắt điểm bằng osnap trong khi đang thực hiện lệnh. Có thể bấm F3 để On/Off chế độ Osnap hoặc chọn chế độ bắt điểm bằng Shift+Rightclick (or Rightclick). Ngoài ra còn có thể On/Off chế độ Orthormode để chuyển HCN từ xiên thành ngang.

;;           Lisp ve Hinh chu nhat (dung, nam ngang, nghieng)                ;;
;;---------------------------------------------------------------------------;;
;;  Author: KangKung 01-10-2013 v1.0                                         ;;
;;  Member of CADMagic Group                                                 ;;
;;---------------------------------------------------------------------------;;
(vl-load-com)
(defun OrthoRound (ang)
  (* (/ pi 2) (fix (/ (+ (/ pi 4) ang) (/ pi 2))))
)
(defun *error* (msg)
  (redraw)
  (setvar "osmode" os)
  )
(defun C:Tre( / os ANG ANG1 GR PT PT1 str LOOP N PO PT X-DIM Y-DIM rightclick batdiem os_pre pt temp)
  (setq temp '(25 0))
  (vla-startundomark (vla-get-activedocument(vlax-get-acad-object)))
  (setq os(getvar "osmode"))
  (setq rightclick 0)
  (initget 1)
  (setq pt1(getpoint "\n Specify first corner point: "))
  (setq ang(getangle pt1 "\n Angle: "))
  (setq ang1 ang)
  (prompt "\n Specify second corner point: ")
  (setq loop T)
  (while (and (setq gr (grread T 12 0)) loop)
    (cond
      ;; Dragging
      ((= 5 (car gr))
       
       (redraw)
       (setq pt (cadr gr))
       (if (and (< 0 (getvar "osmode") 16384)
	     (setq po (vl-remove-if (function null) (mapcar (function (lambda (x / o) (if (setq o (osnap pt x)) (list (distance pt o) o x pt))))
   	(get_osmode)))))
	(setq po (cdar (vl-sort po (function (lambda (a b) (< (car a) (car b)))))) pt (car po))
	(setq po nil))
    (and po (OsMark po))
    (#eMake:Rectang_grvecs pt1 pt nil nil ang nil)
       )
      ;; Picked point = ends loop
      ((= 3 (car gr))
       (#eMake:Rectang pt1 pt nil nil ang nil)
       (redraw)
       (setq loop nil))
      ;; Enter = reads the command line input
      ((or (equal gr '(2 13)) (equal gr '(2 32)))
       (cond
	 ;; valid distance = ends loop
	 ((and str (= (substr str 1 1) "@"))
	  (setq str(vl-string-left-trim "@" str))
	  (setq n(vl-string-search "," str))
	  (setq X-dim(substr str 1 n))
	  (setq Y-dim(substr str (+ n 2)))
	  (if (and (distof X-dim) (distof Y-dim) (/= (+ (distof X-dim) (distof Y-dim)) 0))
	    (progn
	      (#eMake:Rectang pt1 nil (distof X-dim) (distof Y-dim) ang nil)
	      (redraw)
	      (setq loop nil)
	      (grtext)
	      )
	    (princ "\nInvalid Input\n")
	    )
	  )
	 ;; valid point = ends loop
	 ((and str (setq pt (str2pt str)))
	  (#eMake:Rectang pt1 pt nil nil ang nil)
	  (redraw)
	  (setq loop nil)
	  (grtext)
	  )
	 ;; invalid input
	 (T
	  (setq str nil)
	  (princ "\nInvalid Input\n")
	  )
	 )
       )

      ;Right click
      ((= 25 (car gr))
       (setq rightclick(1+ rightclick))
       (if (= rightclick 1) (setq os_pre(getvar "osmode")))
       (setq temp gr)
       (setq batdiem(menu-pop500 gr))
       (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua")
		    (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea")
		    (2048 "_app"))
	 (if (= batdiem (cadr a)) (setvar "osmode" (car a))))
       )

      ;Shift + Right click
      ((equal gr '(11 1000))
       (setq rightclick(1+ rightclick))
       (if (= rightclick 1) (setq os_pre(getvar "osmode")))
       (setq batdiem(menu-pop500 temp))
       (foreach a '((1 "_end") (2 "_mid") (4 "_cen") (8 "_nod") (16 "_qua")
		    (32 "_int") (64 "_ins") (128 "_per") (256 "_tan") (512 "_nea")
		    (2048 "_app"))
	 (if (= batdiem (cadr a)) (setvar "osmode" (car a))))
       )
      ;; F3 = toggles osmode
      ((equal gr '(2 6))
       (if (= (getvar "osmode") 0)
	 (setvar "osmode" (if (/= os 0) os 15359))
	 (setvar "osmode" (if (/= os 0) 0 os))
	 ))
      ;; F8 = toggles orthomode
      ((equal gr '(2 15))
       (setvar "ORTHOMODE" (boole 6 1 (getvar "ORTHOMODE")))
       (if (= (getvar "ORTHOMODE") 1)
	 (setq ang(OrthoRound ang))
	 (setq ang ang1)
	 )
       (princ (chr 8))
       (princ (chr 32))
       )
       ;; getting and printing command line input
      (T
       (if (= (cadr gr) 8) ;_ backspace
	 (or
	   (and str
		(/= str "")
		(setq str (substr str 1 (1- (strlen str))))
		(princ (chr 8))
		(princ (chr 32))
		)
	   (setq str nil)
	   )
	 (or
	   (and str (setq str (strcat str (chr (cadr gr)))))
	   (setq str (chr (cadr gr)))
	   )
	 )
       (and str (princ (chr (cadr gr))))
       )
            
      )
    )
  (if os_pre (setvar "osmode" os_pre))
  (vla-endundomark (vla-get-activedocument(vlax-get-acad-object)))
  (princ)
  )

;--------------------------------------------------------------------------- SUB FUNCTIONS
;----- T¹o Icon Osnap vµ g¸n vµo ®iÓm po, EX: !po = ((94.4953 17.8586 0.0) "_mid" (94.0427 14.9045 0.0)), lÊy pt = (car po).
(defun osMark (o / s osGrv)
  (setq	osGrv (osmode-grvecs-lst
		(vla-get-AutoSnapMarkerColor
		  (vla-get-drafting
		    (vla-get-preferences (vlax-get-acad-object))
		  )
		)
		(vla-get-AutoSnapMarkerSize
		  (vla-get-drafting
		    (vla-get-preferences (vlax-get-acad-object))
		  )
		)
	      )
  )
  (setq	s (/ (getvar "viewsize") (cadr (getvar "screensize")))
	o (cons (trans (car o) 1 3) (cdr o))
  )
  (grvecs (cdr (assoc (cadr o) osGrv))
	  (list	(list s 0. 0. (caar o))
		(list 0. s 0. (cadar o))
		(list 0. 0. s 0.)
		(list 0. 0. 0. 1.)
	  )
  )
)
(defun osmode-grvecs-lst (col ass / -ass ass col) ; By Evgeniy Elpanov (Modified by Lee McDonnell)
  (setq -ass (- ass))
  (list (list "_end"
              col (list -ass -ass) (list -ass  ass)
              col (list (1-  -ass) (1- -ass)) (list (1- -ass) (1+  ass))              
              col (list -ass  ass) (list  ass  ass)
              col (list (1-  -ass) (1+  ass)) (list (1+  ass) (1+  ass))              
              col (list  ass  ass) (list  ass -ass)
              col (list (1+   ass) (1+  ass)) (list (1+  ass) (1- -ass))              
              col (list  ass -ass) (list -ass -ass)
              col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_mid"
              col (list -ass -ass) (list    0. ass)
              col (list (1-  -ass) (1- -ass)) (list 0. (1+  ass))
              col (list    0. ass) (list  ass -ass)
              col (list 0. (1+  ass)) (list (1+  ass) (1- -ass))
              col (list  ass -ass) (list -ass -ass)
              col (list (1+   ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_cen"
              7   (list (* -ass 0.2) 0.)  (list (*  ass 0.2) 0.)
              7   (list  0. (* -ass 0.2)) (list  0.  (*  ass 0.2))
              col (list    -ass   0.) 	(list (* -ass 0.86) (* ass  0.5))
              col (list (* -ass 0.86) (* ass  0.5))  (list (* -ass  0.5) (* ass 0.86))
              col (list (* -ass  0.5) (* ass 0.86))  (list 0. ass)
              col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
              col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
              col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
              col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
              col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
        (list "_nod"
              col (list -ass -ass)    (list ass ass)
              col (list -ass ass) 	(list ass -ass)
              col (list -ass 0.)      (list (* -ass 0.86) (* ass 0.5))
              col (list (* -ass 0.86) (* ass 0.5))   (list (* -ass 0.5) (* ass 0.86))
              col (list (* -ass 0.5)  (* ass 0.86))  (list 0. ass)
              col (list 0. ass) (list (* ass 0.5)    (* ass 0.86))
              col (list (* ass 0.5)   (* ass 0.86))  (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5))   (list ass 0.)
              col (list ass 0.) (list (* ass 0.86)   (* -ass 0.5))
              col (list (* ass 0.86)  (* -ass 0.5))  (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5)   (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5)   (* -ass 0.86))
              col (list (* -ass 0.5)  (* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86) (* -ass 0.5))  (list -ass 0.))
        (list "_qua"
              col (list 0. -ass)   (list -ass 0.)
              col (list 0. (1- -ass))   (list (1- -ass) 0.)
              col (list -ass 0.)   (list 0. ass)
              col (list (1- -ass) 0.)   (list 0. (1+ ass))
              col (list 0. ass)    (list ass 0.)
              col (list 0. (1+ ass))    (list (1+ ass) 0.)
              col (list ass 0.)    (list 0. -ass)
              col (list (1+ ass) 0.)    (list 0. (1- -ass)))
        (list "_int"
              col (list -ass -ass) (list ass ass)
              col (list -ass (1+ -ass)) (list ass (1+ ass))
              col (list (1+ -ass) -ass) (list (1+ ass) ass)
              col (list -ass ass)  (list ass -ass)
              col (list -ass (1+ ass))  (list ass (1+ -ass))
              col (list (1+ -ass) ass)  (list (1+ ass) -ass))
        (list "_ins"
              col (list (* -ass 0.1) (* -ass 0.1)) (list -ass (* -ass 0.1))
              col (list -ass (* -ass 0.1)) (list -ass ass)
              col (list -ass ass) (list (* ass 0.1) ass)
              col (list (* ass 0.1) ass)   (list (* ass 0.1) (* ass 0.1))
              col (list (* ass 0.1) (* ass 0.1))   (list ass (* ass 0.1))
              col (list ass (* ass 0.1))   (list ass -ass)
              col (list ass -ass) (list (* -ass 0.1) -ass)
              col (list (* -ass 0.1) -ass) (list (* -ass 0.1) (* -ass 0.1))
              col (list (1- (* -ass 0.1)) (1- (* -ass 0.1))) (list (1- -ass) (1- (* -ass 0.1)))
              col (list (1- -ass) (1- (* -ass 0.1))) (list (1- -ass) (1+ ass))
              col (list (1- -ass) (1+ ass)) (list (1+ (* ass 0.1)) (1+ ass))
              col (list (1+ (* ass 0.1)) (1+ ass)) (list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
              col (list (1+ (* ass 0.1)) (1+ (* ass 0.1))) (list (1+ ass) (1+ (* ass 0.1)))
              col (list (1+ ass) (1+ (* ass 0.1)))   (list (1+ ass) (1- -ass))
              col (list (1+ ass) (1- -ass)) (list (1- (* -ass 0.1)) (1- -ass))
              col (list (1- (* -ass 0.1))   (1- -ass)) (list (1- (* -ass 0.1)) (1- (* -ass 0.1))))
        (list "_tan"
              col (list -ass ass) (list ass ass)
              col (list (1- -ass) (1+ ass)) (list (1+ ass) (1+ ass))
              col (list -ass 0.)  (list (* -ass 0.86) (* ass 0.5))
              col (list (* -ass 0.86) (* ass 0.5)) (list (* -ass 0.5) (* ass 0.86))
              col (list (* -ass 0.5) (* ass 0.86)) (list 0. ass)
              col (list 0. ass) (list  (* ass 0.5) (* ass 0.86))
              col (list (* ass 0.5)  (* ass 0.86)) (list (* ass 0.86) (* ass 0.5))
              col (list (* ass 0.86)  (* ass 0.5)) (list ass 0.)
              col (list ass 0.) (list (* ass 0.86) (* -ass 0.5))
              col (list (* ass 0.86) (* -ass 0.5)) (list (* ass 0.5) (* -ass 0.86))
              col (list (* ass 0.5) (* -ass 0.86)) (list 0. -ass)
              col (list 0. -ass)(list (* -ass 0.5) (* -ass 0.86))
              col (list (* -ass 0.5)(* -ass 0.86)) (list (* -ass 0.86) (* -ass 0.5))
              col (list (* -ass 0.86)(* -ass 0.5)) (list -ass 0.))
        (list "_per"
              col (list -ass -ass) (list -ass ass)
              col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass))
              col (list -ass 0.)   (list 0. 0.)
              col (list -ass -1.)  (list 0. -1.)
              col (list 0. 0.) 	(list 0. -ass)
              col (list -1. 0.)    (list -1. -ass))
        (list "_nea"
              col (list -ass -ass) (list ass ass)
              col (list -ass ass)  (list ass ass)
              col (list (1- -ass)  (1+ ass)) (list (1+ ass) (1+ ass))
              col (list -ass ass)  (list ass -ass)
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass) (1- -ass)) (list (1- -ass) (1- -ass)))
        (list "_app"
              col (list -ass -ass) (list ass ass)
              col (list ass -ass)  (list -ass ass)
              col (list -ass -ass) (list -ass ass)
              col (list (1- -ass)  (1- -ass)) (list (1- -ass) (1+ ass))
              col (list -ass ass)  (list ass ass)
              col (list (1- -ass)  (1+ ass))  (list (1+ ass) (1+ ass))
              col (list ass ass)   (list ass -ass)
              col (list (1+ ass)   (1+ ass))  (list (1+ ass) (1- -ass))
              col (list ass -ass)  (list -ass -ass)
              col (list (1+ ass)   (1- -ass)) (list (1- -ass) (1- -ass)))))

(princ "\n Type TRE to run")

;;;(defun #Rectang(pt)
;;;  (redraw)
;;;  (#eMake:Rectang2 pt1 pt nil nil ang nil)
;;;  )
;; STR2PT
;; Convert a string into a 3d point (input with grread)
;;
;; Argument: a string (ex: "25,63")
;; Return: a 3d point (ex (25.0 63.0 0.0) or nil if invalid string
(defun str2pt (str)
  (setq str (mapcar 'read (str2lst str ",")))
  (if (and (vl-every 'numberp str)
	   (< 1 (length str) 4)
      )
    (trans str 0 0)
  )
)
;; STR2LST
;; Transforms a string with separator into a list of strings
;;
;; Arguments
;; str = the string
;; sep = the separator pattern

(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos)
	  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)
;;----------------=={ Entmake a Rectang }==--------------------------------;;
;;                                                                         ;;
;;  Make a Rectang entity by Entmake                                       ;;
;;-------------------------------------------------------------------------;;
;;  Author: KangKung 24-6-2012 v1.0                                        ;;
;;-------------------------------------------------------------------------;;
;;  Arguments: there are 2 options                                         ;;
;;  a) pt1, pt2 - First conner, opposite conner (nil if width and Height)  ;;
;;     Tilt: Tilt angle of Rectang (Radian)                                ;;
;;     lst : List of dxf / nil                                             ;;
;;  b) pt1, Width, Height - First conner point, 2 dimension (nil if pt2)   ;;
;;     Tilt: Tilt angle of Rectang (Radian)                                ;;
;;     lst : List of dxf / nil                                             ;;
;;-------------------------------------------------------------------------;;
;;  Returns:  Rectang Entity                                               ;;
;;-------------------------------------------------------------------------;;
;;  Usage:  						                   ;;
;; a) (#eMake:Rectang '(0.0 0.0 0.0) '(5.0 5.0 0.0) nil nil (/ pi 6) nil)  ;;
;; b) (#eMake:Rectang '(0.0 0.0 0.0) nil 20 40 (/ pi 6) nil)               ;;
;;-------------------------------------------------------------------------;;
(defun #eMake:Rectang (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4)
  (if (/= nil pt2)
    (progn
      (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt))))
      (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt))))
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt))))
	    p3 pt2
	    p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt))))
	    )
      )
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt))))
	    p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt))))
	    p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt))))
	    )
    )
  (setq lst_Temp (list '(0 . "LWPOLYLINE")
		  '(100 . "AcDbEntity")
		  '(100 . "AcDbPolyline")
		  '(90 . 4)
		  '(70 . 1)
		  (cons 10 p1)
		  (cons 10 p2)
		  (cons 10 p3)
		  (cons 10 p4)
		  )
	)
  (if lst (setq lst_Temp(append lst_Temp lst)))
  (entmake lst_Temp)
  )

(defun #eMake:Rectang_grvecs (pt1 pt2 Width Heigh Tilt lst / #HEIGH #WIDTH LST_TEMP P1 P2 P3 P4)
  (if (/= nil pt2)
    (progn
      (setq #Width (* (distance pt1 pt2) (cos (- (angle pt1 pt2) Tilt))))
      (setq #Heigh (* (distance pt1 pt2) (sin (- (angle pt1 pt2) Tilt))))
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* #Width (cos Tilt))) (+ (cadr pt1) (* #Width (sin Tilt))))
	    p3 pt2
	    p4 (list (- (car pt1) (* #Heigh (sin Tilt))) (+ (cadr pt1) (* #Heigh (cos Tilt))))
	    )
      )
      (setq p1 pt1
	    p2 (list (+ (car pt1) (* Width (cos Tilt))) (+ (cadr pt1) (* Width (sin Tilt))))
	    p3 (list (+ (car pt1) (* Width (cos Tilt)) (- 0 (* Heigh (sin Tilt)))) (+ (cadr pt1) (* Width (sin Tilt)) (* Heigh (cos Tilt))))
	    p4 (list (- (car pt1) (* Heigh (sin Tilt))) (+ (cadr pt1) (* Heigh (cos Tilt))))
	    )
    )
  (grvecs (list 1 p1 p2 2 p2 p3 5 p3 p4 4 p4 p1))
  )

(defun menu-pop500 (d / lst s)
					; Choice function of OSNAP through the shortcut menu.
					; Only, as an example.
					; Is checked up in AutoCad 2004-2007 (En)
					; by ElpanovEvgeniy
					; (2006-10-11)
					; (menu-pop500 (grread t 5))
  (setq
    lst	(reverse
	  (menu-index
	    ((lambda (x) (list (1- (vla-get-count x)) x))
	      (vla-item
		(vla-get-menus
		  (vla-item
		    (vla-get-menugroups
		      (vlax-get-acad-object)
		    ) ;_ vla-get-MenuGroups
		    "ACAD"
		  ) ;_ vla-item
		) ;_ vla-get-Menus
		"&Object Snap Cursor Menu"
	      ) ;_ vla-item
	    )
	  ) ;_ menu-index
	) ;_ reverse
  ) ;_ setq
  (while (and
	   (listp d)
	   (or (= (car d) 5)
	       (= (car d) 11)
	       (= (car d) 12)
	       (= (car d) 25)		; For old version AutoCad
	   ) ;_ or
	 ) ;_ and
    (cond
      ((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
      ((equal d '(11 0)) (menucmd "POP500=*"))
      ((= (car d) 11) (setq s (nth (- (cadr d) 500) lst)))
    ) ;_ cond
    (if	s
      (setq d s)
      (setq d (grread t 5))
    ) ;_ if
  ) ;_ while
  (substr s 1 4)
) ;_ defun
(defun menu-index (l)
					; Creation of the list of choices of choice of OSNAP
					; Is checked up in AutoCad 2004-2007 (En)
					; by ElpanovEvgeniy
					; (2006-10-11)
		  ;|
 (menu-index
 ((lambda (x) (list (1-(vla-get-count x)) x))
 (vla-item
 (vla-get-menus
 (vla-item
 (vla-get-menugroups
 (vlax-get-acad-object)
 ) ;_ vla-get-MenuGroups
 "ACAD"
 ) ;_ vla-item
 ) ;_ vla-get-Menus
 "&Object Snap Cursor Menu"
 ) ;_ vla-item
 )
 ) ;_ menu-index
 |;
  (if (not (minusp (car l)))
    (cond
      ((= (vla-get-type (vla-item (cadr l) (car l))) 0)
       (cons
	 (vla-get-macro (vla-item (cadr l) (car l)))
	 (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_ cons
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 1)
       (menu-index (cons (1- (car l)) (cdr l)))
      )
      ((= (vla-get-type (vla-item (cadr l) (car l))) 2)
       (append
	 (menu-index
	   ((lambda (x) (list (1- (vla-get-count x)) x))
	     (vla-get-submenu (vla-item (cadr l) (car l)))
	   ) ;_ menu-index
	 ) ;_ menu-index
	 (menu-index (cons (1- (car l)) (cdr l)))
       ) ;_ append
      )
    ) ;_ cond
  ) ;_ if
) ;_ defun

(defun get_osmode nil
					; Function create list osmode macro
					; for result (getvar "OSMODE")
					; by Evgeniy Elpanov
					; (get_osmode)
  (mapcar
    (function cdr)
    (vl-remove-if
      (function
	(lambda	(x)
	  (zerop (logand (getvar "OSMODE") (car x)))
	) ;_ lambda
      ) ;_ function
      (append
	(if (< 0 (setq cur_mode (getvar "osmode")) 16384)
	  '((1 . "_end")
	    (2 . "_mid")
	    (4 . "_cen")
	    (8 . "_nod")
	    (16 . "_qua")
	    (32 . "_int")
					;(4096 . "_ext") ; Is not realized
	   )
	) ;_ if
	(if (not (zerop (logand (getvar "autosnap") 16)))
	  '((64 . "_ins")
	    (128 . "_per")
	    (256 . "_tan")
	    (512 . "_nea")
					;(1024 . "_qui") ; Is not realized
	    (2048 . "_app")
					;(8192 . "_par") ; Is not realized
	   )
	) ;_ if
      ) ;_ append
    ) ;_ substr
  ) ;_ mapcar
) ;_ defun
  • 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

ThuyLinh313    156

ThuyLinh313
Đã đăng

KangKung hay ĐVH chỉ có thể bắt điểm duy với nhất với 1 lựa chọn băt điểm. 

Mình thì làm cách khác, và mình có thể làm chế độ bắt điểm tuân theo đúng chế độ bắt điểm hiện hành của cad nữa cơ. và tất nhiên là có thể cùng 1 lúc có thể có nhiều hơn 1 phương pháp bắt điểm hệt như lệnh cad thông thường  B)

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

KangKung    250

KangKung
Đã đăng

ThuyLinh nhầm rồi. Lisp trên hỗ trợ nhiều kiểu truy bắt điểm cùng lúc chứ không phải chỉ duy nhất 1 kiểu. Chỉ thực hiện 1 kiểu bắt điểm duy nhất khi người dùng chọn cách bắt điểm bằng menu khi rightclick.

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
×