Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
DanKhaosat

Tạo layer khi vẽ hình chữ nhật

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

Mình sưu tầm được Lisp nay:

Nó vẽ hình chữ nhật khi chọn 3 điểm

Bây giờ muốn bổ sung khi chạy lisp:

1. Tự đông tạo ra Layer có tên CHU_NHAT sau đó các hình chữ nhật vẽ khi chạy Lisp đều mặc định nằm trong Layer CHU_NHAT này,

2. Lisp trên chỉ vẽ hình chữ nhật khi pick 3 điểm (chiều rộng và điểm thư 3 chiều dài) giờ mình muốn bổ sung them chức năng chon chiều dài hình chữ nhật có thể là pick điểm( đã có trong Lisp rồi!) và đanhc hiều dài (10, 15 ... m) thay cho pick điểm thứ 3.

Rất mong các cao thủ chỉ dạy!

 

Đây là Lisp:

 
(defun c:3pr  nil (3p-rec nil)) ;; Standard version
(defun c:3prd nil (3p-rec  t )) ;; Dynamic version
 
;;----------------------------------------------------------------------;;
 
(defun 3p-rec ( dyn / *error* gr1 gr2 lst msg ocs osf osm pt1 pt2 pt3 pt4 pt5 pt6 str tmp vec )
 
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (redraw) (princ)
    )
    
    (if
        (and
            (setq pt1 (getpoint "\nSpecify 1st point: "))
            (setq pt2 (getpoint "\nSpecify 2nd point: " pt1))
            (or   dyn (setq pt3 (getpoint "\nSpecify 3rd point: " pt1)))
            (setq vec (trans (mapcar '- pt2 pt1) 1 0 t)
                  ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  pt4 (trans pt1 1 vec)
                  pt5 (trans pt2 1 vec)
            )
            (if dyn
                (progn
                    (setq osf (LM:grsnap:snapfunction)
                          osm (getvar 'osmode)
                          msg "\nSpecify 3rd point: "
                          str ""
                    )
                    (princ msg)
                    (while
                        (progn
                            (setq gr1 (grread t 15 0)
                                  gr2 (cadr gr1)
                                  gr1 (car  gr1)
                            )
                            (cond
                                (   (or (= 5 gr1) (= 3 gr1))
                                    (redraw)
                                    (osf gr2 osm)
                                    (setq pt6 (trans gr2 1 vec))
                                    (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                                        (setq lst
                                            (list pt1 pt2
                                                (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec 1)
                                                (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec 1)
                                            )
                                        )
                                        (cons (last lst) lst)
                                    )
                                    (= 5 gr1)
                                )
                                (   (= 2 gr1)
                                    (cond
                                        (   (= 6 gr2)
                                            (if (zerop (logand 16384 (setq osm (setvar 'osmode (boole 6 16384 (getvar 'osmode))))))
                                                (princ "\n<Osnap on>")
                                                (princ "\n<Osnap off>")
                                            )
                                            (princ msg)
                                        )
                                        (   (= 8 gr2)
                                            (if (< 0 (strlen str))
                                                (progn
                                                    (princ "\010\040\010")
                                                    (setq str (substr str 1 (1- (strlen str))))
                                                )
                                            )
                                            t
                                        )
                                        (   (< 32 gr2 127)
                                            (setq str (strcat str (princ (chr gr2))))
                                        )
                                        (   (member gr2 '(13 32))
                                            (cond
                                                (   (= "" str) nil)
                                                (   (setq gr2 (LM:grsnap:parsepoint pt1 str))
                                                    (setq osm 16384)
                                                    nil
                                                )
                                                (   (setq tmp (LM:grsnap:snapmode str))
                                                    (setq osm tmp
                                                          str ""
                                                    )
                                                )
                                                (   (setq str "")
                                                    (princ (strcat "\n2D / 3D Point Required." msg))
                                                )
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                    (if (listp gr2)
                        (setq pt6 (trans (osf gr2 osm) 1 vec))
                    )
                )
                (setq pt6 (trans pt3 1 vec))
            )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 4)
               '(070 . 1)
                (cons 010 (trans pt1 1 ocs))
                (cons 010 (trans pt2 1 ocs))
                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec ocs))
                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec ocs))
                (cons 210 ocs)
            )
        )
    )
    (redraw) (princ)
)
 
 
 
(defun LM:grsnap:snapfunction ( )
    (eval
        (list 'lambda '( p o / q )
            (list 'if '(zerop (logand 16384 o))
                (list 'if
                   '(setq q
                        (cdar
                            (vl-sort
                                (vl-remove-if 'null
                                    (mapcar
                                        (function
                                            (lambda ( a / b )
                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                                                    (list (distance p b) b (car a))
                                                )
                                            )
                                        )
                                       '(
                                            (0001 . "_end")
                                            (0002 . "_mid")
                                            (0004 . "_cen")
                                            (0008 . "_nod")
                                            (0016 . "_qua")
                                            (0032 . "_int")
                                            (0064 . "_ins")
                                            (0128 . "_per")
                                            (0256 . "_tan")
                                            (0512 . "_nea")
                                            (2048 . "_app")
                                            (8192 . "_par")
                                        )
                                    )
                                )
                               '(lambda ( a b ) (< (car a) (car b)))
                            )
                        )
                    )
                    (list 'LM:grsnap:displaysnap '(car q)
                        (list 'cdr
                            (list 'assoc '(cadr q)
                                (list 'quote
                                    (LM:grsnap:snapsymbols
                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                                    )
                                )
                            )
                        )
                        (LM:OLE->ACI
                            (if (= 1 (getvar 'cvport))
                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                            )
                        )
                    )
                )
            )
           '(cond ((car q)) (p))
        )
    )
)
 
 
(defun LM:grsnap:displaysnap ( pnt lst col / scl )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt (trans pnt 1 2)
    )
    (grvecs (cons col lst)
        (list
            (list scl 0.0 0.0 (car  pnt))
            (list 0.0 scl 0.0 (cadr pnt))
            (list 0.0 0.0 scl 0.0)
           '(0.0 0.0 0.0 1.0)
        )
    )
)
 
 
(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
    (setq -p (- p) q (1+  p)
          -q (- q) r (+ 2 p)
          -r (- r) i (/ pi 6.0)
           a 0.0
    )
    (repeat 12
        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
              a (- a i)
        )
    )
    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
    (list
        (list 1
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 2
            (list -r -q) (list 0  r) (list 0  r) (list r -q)
            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
        )
        (cons 4 c)
        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
        (list 16
            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
        )
        (list 32
            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
        )
        (list 64
            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
        )
        (list 128
            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
            (list -p q) (list -p -p) (list -p -p) (list q -p)
            (list -q q) (list -q -q) (list -q -q) (list q -q)
        )
        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
        (list 512
            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
        )
        (list 2048
            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
    )
)
 
 
 
(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )
 
    (defun str->lst ( str / pos )
        (if (setq pos (vl-string-position 44 str))
            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
            (list str)
        )
    )
 
    (if (wcmatch str "`@*")
        (setq str (substr str 2))
        (setq bpt '(0.0 0.0 0.0))
    )           
 
    (if
        (and
            (setq lst (mapcar 'distof (str->lst str)))
            (vl-every 'numberp lst)
            (< 1 (length lst) 4)
        )
        (mapcar '+ bpt lst)
    )
)
 
 
 
(defun LM:grsnap:snapmode ( str )
    (vl-some
        (function
            (lambda ( x )
                (if (wcmatch (car x) (strcat (strcase str t) "*"))
                    (progn
                        (princ (cadr x)) (caddr x)
                    )
                )
            )
        )
       '(
            ("endpoint"      " of " 00001)
            ("midpoint"      " of " 00002)
            ("center"        " of " 00004)
            ("node"          " of " 00008)
            ("quadrant"      " of " 00016)
            ("intersection"  " of " 00032)
            ("insert"        " of " 00064)
            ("perpendicular" " to " 00128)
            ("tangent"       " to " 00256)
            ("nearest"       " to " 00512)
            ("appint"        " of " 02048)
            ("parallel"      " to " 08192)
            ("none"          ""     16384)
        )
    )
)
 
 
 
(defun LM:OLE->ACI ( c )
    (apply 'LM:RGB->ACI (LM:OLE->RGB c))
)
 
 
 
(defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)
 
 
 
(defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (progn
            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
            (vlax-release-object o)
            (if (vl-catch-all-error-p c)
                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                c
            )
        )
    )
)
 
 
 
(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)
 
;;----------------------------------------------------------------------;;
 
(vl-load-com)
(princ
    (strcat
               (menucmd "m=$(edtime,0,yyyy)")
               "\n:: \"3PR\" - Standard | \"3PRD\" - Dynamic ::"
    )
)
(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

Mình sưu tầm được Lisp nay:


Nó vẽ hình chữ nhật khi chọn 3 điểm


Bây giờ muốn bổ sung khi chạy lisp:


1. Tự đông tạo ra Layer có tên CHU_NHAT sau đó các hình chữ nhật vẽ khi chạy Lisp đều mặc định nằm trong Layer CHU_NHAT này,


2. Lisp trên chỉ vẽ hình chữ nhật khi pick 3 điểm (chiều rộng và điểm thư 3 chiều dài) giờ mình muốn bổ sung them chức năng chon chiều dài hình chữ nhật có thể là pick điểm( đã có trong Lisp rồi!) và đanhc hiều dài (10, 15 ... m) thay cho pick điểm thứ 3.


Rất mong các cao thủ chỉ dạy!


 


Đây là Lisp:



 

(defun c:3pr  nil (3p-rec nil)) ;; Standard version

(defun c:3prd nil (3p-rec  t )) ;; Dynamic version

 

;;----------------------------------------------------------------------;;

 

(defun 3p-rec ( dyn / *error* gr1 gr2 lst msg ocs osf osm pt1 pt2 pt3 pt4 pt5 pt6 str tmp vec )

 

    (defun *error* ( msg )

        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))

            (princ (strcat "\nError: " msg))

        )

        (redraw) (princ)

    )

    

    (if

        (and

            (setq pt1 (getpoint "\nSpecify 1st point: "))

            (setq pt2 (getpoint "\nSpecify 2nd point: " pt1))

            (or   dyn (setq pt3 (getpoint "\nSpecify 3rd point: " pt1)))

            (setq vec (trans (mapcar '- pt2 pt1) 1 0 t)

                  ocs (trans '(0.0 0.0 1.0) 1 0 t)

                  pt4 (trans pt1 1 vec)

                  pt5 (trans pt2 1 vec)

            )

            (if dyn

                (progn

                    (setq osf (LM:grsnap:snapfunction)

                          osm (getvar 'osmode)

                          msg "\nSpecify 3rd point: "

                          str ""

                    )

                    (princ msg)

                    (while

                        (progn

                            (setq gr1 (grread t 15 0)

                                  gr2 (cadr gr1)

                                  gr1 (car  gr1)

                            )

                            (cond

                                (   (or (= 5 gr1) (= 3 gr1))

                                    (redraw)

                                    (osf gr2 osm)

                                    (setq pt6 (trans gr2 1 vec))

                                    (mapcar '(lambda ( a b ) (grdraw a b 1 1))

                                        (setq lst

                                            (list pt1 pt2

                                                (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec 1)

                                                (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec 1)

                                            )

                                        )

                                        (cons (last lst) lst)

                                    )

                                    (= 5 gr1)

                                )

                                (   (= 2 gr1)

                                    (cond

                                        (   (= 6 gr2)

                                            (if (zerop (logand 16384 (setq osm (setvar 'osmode (boole 6 16384 (getvar 'osmode))))))

                                                (princ "\n<Osnap on>")

                                                (princ "\n<Osnap off>")

                                            )

                                            (princ msg)

                                        )

                                        (   (= 8 gr2)

                                            (if (< 0 (strlen str))

                                                (progn

                                                    (princ "\010\040\010")

                                                    (setq str (substr str 1 (1- (strlen str))))

                                                )

                                            )

                                            t

                                        )

                                        (   (< 32 gr2 127)

                                            (setq str (strcat str (princ (chr gr2))))

                                        )

                                        (   (member gr2 '(13 32))

                                            (cond

                                                (   (= "" str) nil)

                                                (   (setq gr2 (LM:grsnap:parsepoint pt1 str))

                                                    (setq osm 16384)

                                                    nil

                                                )

                                                (   (setq tmp (LM:grsnap:snapmode str))

                                                    (setq osm tmp

                                                          str ""

                                                    )

                                                )

                                                (   (setq str "")

                                                    (princ (strcat "\n2D / 3D Point Required." msg))

                                                )

                                            )

                                        )

                                    )

                                )

                            )

                        )

                    )

                    (if (listp gr2)

                        (setq pt6 (trans (osf gr2 osm) 1 vec))

                    )

                )

                (setq pt6 (trans pt3 1 vec))

            )

        )

        (entmake

            (list

               '(000 . "LWPOLYLINE")

               '(100 . "AcDbEntity")

               '(100 . "AcDbPolyline")

               '(090 . 4)

               '(070 . 1)

                (cons 010 (trans pt1 1 ocs))

                (cons 010 (trans pt2 1 ocs))

                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec ocs))

                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec ocs))

                (cons 210 ocs)

            )

        )

    )

    (redraw) (princ)

)

 

 

 

(defun LM:grsnap:snapfunction ( )

    (eval

        (list 'lambda '( p o / q )

            (list 'if '(zerop (logand 16384 o))

                (list 'if

                   '(setq q

                        (cdar

                            (vl-sort

                                (vl-remove-if 'null

                                    (mapcar

                                        (function

                                            (lambda ( a / b )

                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))

                                                    (list (distance p b) b (car a))

                                                )

                                            )

                                        )

                                       '(

                                            (0001 . "_end")

                                            (0002 . "_mid")

                                            (0004 . "_cen")

                                            (0008 . "_nod")

                                            (0016 . "_qua")

                                            (0032 . "_int")

                                            (0064 . "_ins")

                                            (0128 . "_per")

                                            (0256 . "_tan")

                                            (0512 . "_nea")

                                            (2048 . "_app")

                                            (8192 . "_par")

                                        )

                                    )

                                )

                               '(lambda ( a b ) (< (car a) (car b)))

                            )

                        )

                    )

                    (list 'LM:grsnap:displaysnap '(car q)

                        (list 'cdr

                            (list 'assoc '(cadr q)

                                (list 'quote

                                    (LM:grsnap:snapsymbols

                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))

                                    )

                                )

                            )

                        )

                        (LM:OLE->ACI

                            (if (= 1 (getvar 'cvport))

                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))

                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))

                            )

                        )

                    )

                )

            )

           '(cond ((car q)) (p))

        )

    )

)

 

 

(defun LM:grsnap:displaysnap ( pnt lst col / scl )

    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))

          pnt (trans pnt 1 2)

    )

    (grvecs (cons col lst)

        (list

            (list scl 0.0 0.0 (car  pnt))

            (list 0.0 scl 0.0 (cadr pnt))

            (list 0.0 0.0 scl 0.0)

           '(0.0 0.0 0.0 1.0)

        )

    )

)

 

 

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )

    (setq -p (- p) q (1+  p)

          -q (- q) r (+ 2 p)

          -r (- r) i (/ pi 6.0)

           a 0.0

    )

    (repeat 12

        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)

              a (- a i)

        )

    )

    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))

    (list

        (list 1

            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)

        )

        (list 2

            (list -r -q) (list 0  r) (list 0  r) (list r -q)

            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)

        )

        (cons 4 c)

        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)

        (list 16

            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)

            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)

            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)

        )

        (list 32

            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)

            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)

        )

        (list 64

            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)

            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)

            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)

            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)

        )

        (list 128

            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))

            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))

            (list -p q) (list -p -p) (list -p -p) (list q -p)

            (list -q q) (list -q -q) (list -q -q) (list q -q)

        )

        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)

        (list 512

            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)

            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)

        )

        (list 2048

            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)

            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)

            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)

            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)

            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)

        )

        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))

    )

)

 

 

 

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )

 

    (defun str->lst ( str / pos )

        (if (setq pos (vl-string-position 44 str))

            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))

            (list str)

        )

    )

 

    (if (wcmatch str "`@*")

        (setq str (substr str 2))

        (setq bpt '(0.0 0.0 0.0))

    )           

 

    (if

        (and

            (setq lst (mapcar 'distof (str->lst str)))

            (vl-every 'numberp lst)

            (< 1 (length lst) 4)

        )

        (mapcar '+ bpt lst)

    )

)

 

 

 

(defun LM:grsnap:snapmode ( str )

    (vl-some

        (function

            (lambda ( x )

                (if (wcmatch (car x) (strcat (strcase str t) "*"))

                    (progn

                        (princ (cadr x)) (caddr x)

                    )

                )

            )

        )

       '(

            ("endpoint"      " of " 00001)

            ("midpoint"      " of " 00002)

            ("center"        " of " 00004)

            ("node"          " of " 00008)

            ("quadrant"      " of " 00016)

            ("intersection"  " of " 00032)

            ("insert"        " of " 00064)

            ("perpendicular" " to " 00128)

            ("tangent"       " to " 00256)

            ("nearest"       " to " 00512)

            ("appint"        " of " 02048)

            ("parallel"      " to " 08192)

            ("none"          ""     16384)

        )

    )

)

 

 

 

(defun LM:OLE->ACI ( c )

    (apply 'LM:RGB->ACI (LM:OLE->RGB c))

)

 

 

 

(defun LM:OLE->RGB ( c )

    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))

)

 

 

 

(defun LM:RGB->ACI ( r g b / c o )

    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))

        (progn

            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))

            (vlax-release-object o)

            (if (vl-catch-all-error-p c)

                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))

                c

            )

        )

    )

)

 

 

 

(defun LM:acapp nil

    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))

    (LM:acapp)

)

 

;;----------------------------------------------------------------------;;

 

(vl-load-com)

(princ

    (strcat

            (menucmd "m=$(edtime,0,yyyy)")

               "\n:: \"3PR\" - Standard | \"3PRD\" - Dynamic ::"

    )

)

(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

Mình sưu tầm được Lisp nay:


Nó vẽ hình chữ nhật khi chọn 3 điểm


Bây giờ muốn bổ sung khi chạy lisp:


1. Tự đông tạo ra Layer có tên CHU_NHAT sau đó các hình chữ nhật vẽ khi chạy Lisp đều mặc định nằm trong Layer CHU_NHAT này,


2. Lisp trên chỉ vẽ hình chữ nhật khi pick 3 điểm (chiều rộng và điểm thư 3 chiều dài) giờ mình muốn bổ sung them chức năng chon chiều dài hình chữ nhật có thể là pick điểm( đã có trong Lisp rồi!) và đanhc hiều dài (10, 15 ... m) thay cho pick điểm thứ 3.


Rất mong các cao thủ chỉ dạy!


 


Đây là Lisp:



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

Mình sưu tầm được Lisp nay:


Nó vẽ hình chữ nhật khi chọn 3 điểm


Bây giờ muốn bổ sung khi chạy lisp:


1. Tự đông tạo ra Layer có tên CHU_NHAT sau đó các hình chữ nhật vẽ khi chạy Lisp đều mặc định nằm trong Layer CHU_NHAT này,


2. Lisp trên chỉ vẽ hình chữ nhật khi pick 3 điểm (chiều rộng và điểm thư 3 chiều dài) giờ mình muốn bổ sung them chức năng chon chiều dài hình chữ nhật có thể là pick điểm( đã có trong Lisp rồi!) và đanhc hiều dài (10, 15 ... m) thay cho pick điểm thứ 3.


Rất mong các cao thủ chỉ dạy!


 


Đây là Lisp:


ADMin thế nào không dưa được file lên nhỉ!http://www.cadviet.com/upfiles/4/123341_3precv110_1.lsp


 

(defun c:3pr  nil (3p-rec nil)) ;; Standard version

(defun c:3prd nil (3p-rec  t )) ;; Dynamic version

 

;;----------------------------------------------------------------------;;

 

(defun 3p-rec ( dyn / *error* gr1 gr2 lst msg ocs osf osm pt1 pt2 pt3 pt4 pt5 pt6 str tmp vec )

 

    (defun *error* ( msg )

        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))

            (princ (strcat "\nError: " msg))

        )

        (redraw) (princ)

    )

    

    (if

        (and

            (setq pt1 (getpoint "\nSpecify 1st point: "))

            (setq pt2 (getpoint "\nSpecify 2nd point: " pt1))

            (or   dyn (setq pt3 (getpoint "\nSpecify 3rd point: " pt1)))

            (setq vec (trans (mapcar '- pt2 pt1) 1 0 t)

                  ocs (trans '(0.0 0.0 1.0) 1 0 t)

                  pt4 (trans pt1 1 vec)

                  pt5 (trans pt2 1 vec)

            )

            (if dyn

                (progn

                    (setq osf (LM:grsnap:snapfunction)

                          osm (getvar 'osmode)

                          msg "\nSpecify 3rd point: "

                          str ""

                    )

                    (princ msg)

                    (while

                        (progn

                            (setq gr1 (grread t 15 0)

                                  gr2 (cadr gr1)

                                  gr1 (car  gr1)

                            )

                            (cond

                                (   (or (= 5 gr1) (= 3 gr1))

                                    (redraw)

                                    (osf gr2 osm)

                                    (setq pt6 (trans gr2 1 vec))

                                    (mapcar '(lambda ( a b ) (grdraw a b 1 1))

                                        (setq lst

                                            (list pt1 pt2

                                                (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec 1)

                                                (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec 1)

                                            )

                                        )

                                        (cons (last lst) lst)

                                    )

                                    (= 5 gr1)

                                )

                                (   (= 2 gr1)

                                    (cond

                                        (   (= 6 gr2)

                                            (if (zerop (logand 16384 (setq osm (setvar 'osmode (boole 6 16384 (getvar 'osmode))))))

                                                (princ "\n<Osnap on>")

                                                (princ "\n<Osnap off>")

                                            )

                                            (princ msg)

                                        )

                                        (   (= 8 gr2)

                                            (if (< 0 (strlen str))

                                                (progn

                                                    (princ "\010\040\010")

                                                    (setq str (substr str 1 (1- (strlen str))))

                                                )

                                            )

                                            t

                                        )

                                        (   (< 32 gr2 127)

                                            (setq str (strcat str (princ (chr gr2))))

                                        )

                                        (   (member gr2 '(13 32))

                                            (cond

                                                (   (= "" str) nil)

                                                (   (setq gr2 (LM:grsnap:parsepoint pt1 str))

                                                    (setq osm 16384)

                                                    nil

                                                )

                                                (   (setq tmp (LM:grsnap:snapmode str))

                                                    (setq osm tmp

                                                          str ""

                                                    )

                                                )

                                                (   (setq str "")

                                                    (princ (strcat "\n2D / 3D Point Required." msg))

                                                )

                                            )

                                        )

                                    )

                                )

                            )

                        )

                    )

                    (if (listp gr2)

                        (setq pt6 (trans (osf gr2 osm) 1 vec))

                    )

                )

                (setq pt6 (trans pt3 1 vec))

            )

        )

        (entmake

            (list

               '(000 . "LWPOLYLINE")

               '(100 . "AcDbEntity")

               '(100 . "AcDbPolyline")

               '(090 . 4)

               '(070 . 1)

                (cons 010 (trans pt1 1 ocs))

                (cons 010 (trans pt2 1 ocs))

                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec ocs))

                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec ocs))

                (cons 210 ocs)

            )

        )

    )

    (redraw) (princ)

)

 

 

 

(defun LM:grsnap:snapfunction ( )

    (eval

        (list 'lambda '( p o / q )

            (list 'if '(zerop (logand 16384 o))

                (list 'if

                   '(setq q

                        (cdar

                            (vl-sort

                                (vl-remove-if 'null

                                    (mapcar

                                        (function

                                            (lambda ( a / b )

                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))

                                                    (list (distance p B) b (car a))

                                                )

                                            )

                                        )

                                       '(

                                            (0001 . "_end")

                                            (0002 . "_mid")

                                            (0004 . "_cen")

                                            (0008 . "_nod")

                                            (0016 . "_qua")

                                            (0032 . "_int")

                                            (0064 . "_ins")

                                            (0128 . "_per")

                                            (0256 . "_tan")

                                            (0512 . "_nea")

                                            (2048 . "_app")

                                            (8192 . "_par")

                                        )

                                    )

                                )

                               '(lambda ( a b ) (< (car a) (car B)))

                            )

                        )

                    )

                    (list 'LM:grsnap:displaysnap '(car q)

                        (list 'cdr

                            (list 'assoc '(cadr q)

                                (list 'quote

                                    (LM:grsnap:snapsymbols

                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))

                                    )

                                )

                            )

                        )

                        (LM:OLE->ACI

                            (if (= 1 (getvar 'cvport))

                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))

                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))

                            )

                        )

                    )

                )

            )

           '(cond ((car q)) (p))

        )

    )

)

 

 

(defun LM:grsnap:displaysnap ( pnt lst col / scl )

    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))

          pnt (trans pnt 1 2)

    )

    (grvecs (cons col lst)

        (list

            (list scl 0.0 0.0 (car  pnt))

            (list 0.0 scl 0.0 (cadr pnt))

            (list 0.0 0.0 scl 0.0)

           '(0.0 0.0 0.0 1.0)

        )

    )

)

 

 

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )

    (setq -p (- p) q (1+  p)

          -q (- q) r (+ 2 p)

          -r (- r) i (/ pi 6.0)

           a 0.0

    )

    (repeat 12

        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)

              a (- a i)

        )

    )

    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))

    (list

        (list 1

            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)

        )

        (list 2

            (list -r -q) (list 0  r) (list 0  r) (list r -q)

            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)

        )

        (cons 4 c)

        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)

        (list 16

            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)

            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)

            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)

        )

        (list 32

            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)

            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)

        )

        (list 64

            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)

            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)

            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)

            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)

        )

        (list 128

            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))

            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))

            (list -p q) (list -p -p) (list -p -p) (list q -p)

            (list -q q) (list -q -q) (list -q -q) (list q -q)

        )

        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)

        (list 512

            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)

            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)

        )

        (list 2048

            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)

            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)

            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)

            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)

            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)

            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)

        )

        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))

    )

)

 

 

 

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )

 

    (defun str->lst ( str / pos )

        (if (setq pos (vl-string-position 44 str))

            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))

            (list str)

        )

    )

 

    (if (wcmatch str "`@*")

        (setq str (substr str 2))

        (setq bpt '(0.0 0.0 0.0))

    )           

 

    (if

        (and

            (setq lst (mapcar 'distof (str->lst str)))

            (vl-every 'numberp lst)

            (< 1 (length lst) 4)

        )

        (mapcar '+ bpt lst)

    )

)

 

 

 

(defun LM:grsnap:snapmode ( str )

    (vl-some

        (function

            (lambda ( x )

                (if (wcmatch (car x) (strcat (strcase str t) "*"))

                    (progn

                        (princ (cadr x)) (caddr x)

                    )

                )

            )

        )

       '(

            ("endpoint"      " of " 00001)

            ("midpoint"      " of " 00002)

            ("center"        " of " 00004)

            ("node"          " of " 00008)

            ("quadrant"      " of " 00016)

            ("intersection"  " of " 00032)

            ("insert"        " of " 00064)

            ("perpendicular" " to " 00128)

            ("tangent"       " to " 00256)

            ("nearest"       " to " 00512)

            ("appint"        " of " 02048)

            ("parallel"      " to " 08192)

            ("none"          ""     16384)

        )

    )

)

 

 

 

(defun LM:OLE->ACI ( c )

    (apply 'LM:RGB->ACI (LM:OLE->RGB c))

)

 

 

 

(defun LM:OLE->RGB ( c )

    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))

)

 

 

 

(defun LM:RGB->ACI ( r g b / c o )

    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))

        (progn

            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g B) (vla-get-colorindex o))))

            (vlax-release-object o)

            (if (vl-catch-all-error-p c)

                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))

                c

            )

        )

    )

)

 

 

 

(defun LM:acapp nil

    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))

    (LM:acapp)

)

 

;;----------------------------------------------------------------------;;

 

(vl-load-com)

(princ

    (strcat

            (menucmd "m=$(edtime,0,yyyy)")

               "\n:: \"3PR\" - Standard | \"3PRD\" - Dynamic ::"

    )

)

(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

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


×