TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Adesu on March 29, 2010, 10:46:57 AM

Title: What wrong with this code
Post by: Adesu on March 29, 2010, 10:46:57 AM

If user click any location, line p3 to p4 there is outside of rectange, it should inner rectang

Code: [Select]

(defun c:kotak3 (/ p1 p2 p3 p4)
  (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
  (if (= p1 nil)(setq p1 '(0 0 0)))
  (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
  (if (= p2 nil)(setq p2 '(10 5 0)))
  (command "_rectangle" p1 p2)
  (command "_line" p1 p2 "")
  (setq p3 (polar p1 0 (car p2)))
  (setq p4 (polar p1 (* pi 0.5)(cadr p2)))
  (command "_line" p3 p4 "")
  (princ)
  ) ; defun


Title: Re: What wrong with this code
Post by: Krushert on March 29, 2010, 10:53:50 AM

Do you have running Osnaps running?  I typical clear or turn off my Osanps before using lisp to draw something

Quote

;;
(setq g(getvar "osmode"))
(command "snap" "off")
;;

Title: Re: What wrong with this code
Post by: Krushert on March 29, 2010, 10:57:45 AM

An I am not 100% percent sure but I think you want to be using P1 not P2. or change your rotation of direction if you need to use P2

Title: Re: What wrong with this code
Post by: Lee Mac on March 29, 2010, 11:11:17 AM

Another way to toggle OSMODE:

Code: [Select]

(defun os (flag) (setvar "OSMODE" (boole (if flag 2 7) (getvar "OSMODE") 16384)))


Title: Re: What wrong with this code
Post by: efernal on March 29, 2010, 03:57:13 PM

(DEFUN c:kotak3   (/ p1 p2 p3 p4)
  (SETQ p1 (GETPOINT "\nklik titik awal <0,0,0> : "))
  (IF (= p1 nil)
    (SETQ p1 '(0 0 0))
  )
  (SETQ p2 (GETCORNER p1 "\nklik titik awal <10,5,0> : "))
  (IF (= p2 nil)
    (SETQ p2 '(10 5 0))
  )
  (COMMAND "_rectangle" p1 p2)
  (COMMAND "_line" p1 p2 "")
  (SETQ p3 (POLAR p1 0 (CAR p2)))
  (SETQ p4 (POLAR p1 (* PI 0.5) (CADR p2)))
  (COMMAND "_line" p3 p4 "")
  (PRINC)
)               ; defun

;; Some changes...
;; e.fernal
(DEFUN c:kotak3   (/ p1 p2 p3 p4 osmode)
  (SETQ p1 (GETPOINT "\nklik titik awal <0,0,0> : "))
  (IF (= p1 nil)
    (SETQ p1 '(0 0 0))
  )
  (SETQ p3 (GETCORNER p1 "\nklik titik awal <10,5,0> : "))
  (IF (= p3 nil)
    (SETQ p3 '(10 5 0))
  )
  (SETQ   p2     (LIST (CAR p3) (CADR p1) (CADDR p1))
   p4     (LIST (CAR p1) (CADR p3) (CADDR p1))
   osmode (GETVAR "OSMODE")
  )
  (IF (AND p1 p2 p3 p4)
    (PROGN (SETVAR "OSMODE" 0)
      (ENTMAKE (LIST '(0 . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           ;;(8 . "0") Put here the desired layer
           '(100 . "AcDbPolyline")
           '(90 . 4)
           '(70 . 1)
           '(43 . 0.0)
           '(38 . 0.0)
           '(39 . 0.0)
           (CONS 10 p1)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p2)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p3)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p4)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           ;;(210 0.0 0.0 1.0)
          )
      )
      (ENTMAKE (LIST (CONS 0 "LINE")
           ;;(8 . "0") Put here the desired layer
           (CONS 10 p1)
           (CONS 11 p3)
          )
      )
      (ENTMAKE (LIST (CONS 0 "LINE")
           ;;(8 . "0") Put here the desired layer
           (CONS 10 p2)
           (CONS 11 p4)
          )
      )
      (SETVAR "OSMODE" osmode)
    )
    nil
  )
  (PRINC)
)

Title: Re: What wrong with this code
Post by: Adesu on March 29, 2010, 09:11:57 PM

Thanks you, it's good solution and i just test it Ok

Quote from: efernal on March 29, 2010, 03:57:13 PM

(DEFUN c:kotak3   (/ p1 p2 p3 p4)
  (SETQ p1 (GETPOINT "\nklik titik awal <0,0,0> : "))
  (IF (= p1 nil)
    (SETQ p1 '(0 0 0))
  )
  (SETQ p2 (GETCORNER p1 "\nklik titik awal <10,5,0> : "))
  (IF (= p2 nil)
    (SETQ p2 '(10 5 0))
  )
  (COMMAND "_rectangle" p1 p2)
  (COMMAND "_line" p1 p2 "")
  (SETQ p3 (POLAR p1 0 (CAR p2)))
  (SETQ p4 (POLAR p1 (* PI 0.5) (CADR p2)))
  (COMMAND "_line" p3 p4 "")
  (PRINC)
)               ; defun

;; Some changes...
;; e.fernal
(DEFUN c:kotak3   (/ p1 p2 p3 p4 osmode)
  (SETQ p1 (GETPOINT "\nklik titik awal <0,0,0> : "))
  (IF (= p1 nil)
    (SETQ p1 '(0 0 0))
  )
  (SETQ p3 (GETCORNER p1 "\nklik titik awal <10,5,0> : "))
  (IF (= p3 nil)
    (SETQ p3 '(10 5 0))
  )
  (SETQ   p2     (LIST (CAR p3) (CADR p1) (CADDR p1))
   p4     (LIST (CAR p1) (CADR p3) (CADDR p1))
   osmode (GETVAR "OSMODE")
  )
  (IF (AND p1 p2 p3 p4)
    (PROGN (SETVAR "OSMODE" 0)
      (ENTMAKE (LIST '(0 . "LWPOLYLINE")
           '(100 . "AcDbEntity")
           ;;(8 . "0") Put here the desired layer
           '(100 . "AcDbPolyline")
           '(90 . 4)
           '(70 . 1)
           '(43 . 0.0)
           '(38 . 0.0)
           '(39 . 0.0)
           (CONS 10 p1)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p2)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p3)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           (CONS 10 p4)
           '(40 . 0.0)
           '(41 . 0.0)
           '(42 . 0.0)
           '(91 . 0)
           ;;(210 0.0 0.0 1.0)
          )
      )
      (ENTMAKE (LIST (CONS 0 "LINE")
           ;;(8 . "0") Put here the desired layer
           (CONS 10 p1)
           (CONS 11 p3)
          )
      )
      (ENTMAKE (LIST (CONS 0 "LINE")
           ;;(8 . "0") Put here the desired layer
           (CONS 10 p2)
           (CONS 11 p4)
          )
      )
      (SETVAR "OSMODE" osmode)
    )
    nil
  )
  (PRINC)
)

Title: Re: What wrong with this code
Post by: Adesu on March 29, 2010, 09:17:18 PM

last night I got solution for this code

Code: [Select]

(defun c:kotak3 (/ p1 p2 p3 p4)
  (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
  (if (= p1 nil)(setq p1 '(0 0 0)))
  (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
  (if (= p2 nil)(setq p2 '(10 5 0)))
  (command "_rectangle" p1 p2)
  (setq ent (entlast))
  (command "_line" p1 p2 "")
  (setq eg (entget ent))
  (setq lst (massoc 10 eg))
  (setq len (distance (cadr lst)(car lst)))
  (setq wid (distance (cadddr lst)(car lst)))
  (setq p3 (polar p1 0 len))
  (setq p4 (polar p1 (* pi 0.5) wid))
  (command "_line" p3 p4 "")
  (princ)
  ) ; defun

(defun massoc (key alist / x nlist) ; Jaysen Long
  (foreach x alist
    (if
      (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
      )
    )
  (reverse nlist)
  )


Title: Re: What wrong with this code
Post by: CAB on March 30, 2010, 12:25:03 AM

Code: [Select]

(defun c:x3 (/ p1 p2 min-x min-y max-x max-y)
  (or (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
    (setq p1 '(0 0 0))
  )
  (or (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
    (setq p2 '(10 5 0))
  )
  (command "_rectangle" "_non" p1 "_non" p2)
  (setq min-x (apply 'min (mapcar 'car (list p1 p2))))
  (setq min-y (apply 'min (mapcar 'cadr (list p1 p2))))
  (setq max-x (apply 'max (mapcar 'car (list p1 p2))))
  (setq max-y (apply 'max (mapcar 'cadr (list p1 p2))))
  (command "_line" "_non" (list min-x min-y) "_non" (list max-x max-y) "")
  (command "_line" "_non" (list max-x min-y) "_non" (list min-x max-y) "")
  (princ)
)

Title: Re: What wrong with this code
Post by: Lee Mac on March 30, 2010, 05:38:54 AM

Perhaps OTT, but I had fun this morning  :-)

Code: [Select]

(defun c:x4 (/ _PromptWithDefault LWPoly Line GroupByNum lst p1 p2)
  ;; Lee Mac  ~  30.03.10

  (defun _PromptWithDefault (f arg d)
    (cond ((apply f arg)) (d)))
 
  (defun LWPoly (lst cls)
    (entmakex (append (list (cons 0 "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length lst))
                            (cons 70 cls))
                      (mapcar (function (lambda (p) (cons 10 p))) lst))))

  (defun Line (p1 p2)
    (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))

  (defun GroupByNum (lst num / rtn)
    (setq rtn nil)
 
    (if lst
      (cons (reverse
              (repeat num
                (progn
                  (setq rtn (cons (car lst) rtn)
                        lst (cdr lst))
                  rtn)))

            (GroupByNum lst num))))
 

  (setq p2 (_PromptWithDefault (function getcorner)
             (list "\nklik titik awal <10,5,0> : "
                   (setq p1 (_PromptWithDefault (function getpoint)
                              '("\nklik titik awal <0,0,0> : ") '(0 0 0)))) '(10 5 0)))

  (setq lst
         
    (  (lambda (data)
         (mapcar
           (function
             (lambda (funcs)
               (mapcar
                 (function
                   (lambda (func)
                     ((eval func) data)))

                 funcs)))

           '((caar   cadar)
             (caadr  cadar)
             (caadr cadadr)
             (caar  cadadr))))

      (list p1 p2)))

  (LWPoly lst 1)
  (apply (function mapcar) (cons (function Line) (GroupByNum lst 2)))

  (princ))
 


Title: Re: What wrong with this code
Post by: CAB on March 30, 2010, 08:32:48 AM

After one cup this morning.

Code: [Select]

(defun c:x3 (/ p1 p2)
  (or (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
    (setq p1 '(0 0 0))
  )
  (or (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
    (setq p2 '(10 5 0))
  )
  (command "_rectangle" "_non" p1 "_non" p2)
  (command "_line" "_non" p1 "_non" p2 "")
  (command "_line" "_non" (list (car p1)(cadr p2)) "_non" (list (car p2)(cadr p1)) "")
  (princ)
)

Title: Re: What wrong with this code
Post by: Lee Mac on March 30, 2010, 08:48:47 AM

BTW Efernal, code is easier to read if you wrap it in [_code] [/_code] tags (without the "_" )  :-)

Title: Re: What wrong with this code
Post by: MP on March 30, 2010, 09:12:10 AM

Quote from: Lee Mac on March 30, 2010, 08:48:47 AM

BTW Efernal, code is easier to read if you wrap it in [_code] [/_code] tags (without the "_" )  :-)

yep:

(http://www.theswamp.org/screens/mp/codetags2.png)

from this (http://www.theswamp.org/index.php?topic=4429.0)

Title: Re: What wrong with this code
Post by: Adesu on March 30, 2010, 10:09:37 AM

Hi CAB your code very good I just test,thank.

Quote from: CAB on March 30, 2010, 12:25:03 AM

Code: [Select]

(defun c:x3 (/ p1 p2 min-x min-y max-x max-y)
  (or (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
    (setq p1 '(0 0 0))
  )
  (or (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
    (setq p2 '(10 5 0))
  )
  (command "_rectangle" "_non" p1 "_non" p2)
  (setq min-x (apply 'min (mapcar 'car (list p1 p2))))
  (setq min-y (apply 'min (mapcar 'cadr (list p1 p2))))
  (setq max-x (apply 'max (mapcar 'car (list p1 p2))))
  (setq max-y (apply 'max (mapcar 'cadr (list p1 p2))))
  (command "_line" "_non" (list min-x min-y) "_non" (list max-x max-y) "")
  (command "_line" "_non" (list max-x min-y) "_non" (list min-x max-y) "")
  (princ)
)

Title: Re: What wrong with this code
Post by: Adesu on March 30, 2010, 10:13:31 AM

This is good too and more simple,thank

Quote from: CAB on March 30, 2010, 08:32:48 AM

After one cup this morning.

Code: [Select]

(defun c:x3 (/ p1 p2)
  (or (setq p1 (getpoint "\nklik titik awal <0,0,0> : "))
    (setq p1 '(0 0 0))
  )
  (or (setq p2 (getcorner p1 "\nklik titik awal <10,5,0> : "))
    (setq p2 '(10 5 0))
  )
  (command "_rectangle" "_non" p1 "_non" p2)
  (command "_line" "_non" p1 "_non" p2 "")
  (command "_line" "_non" (list (car p1)(cadr p2)) "_non" (list (car p2)(cadr p1)) "")
  (princ)
)

Title: Re: What wrong with this code
Post by: Adesu on March 30, 2010, 10:29:15 AM

Your code good too,thanks.

Quote from: Lee Mac on March 30, 2010, 05:38:54 AM

Perhaps OTT, but I had fun this morning  :-)

Code: [Select]

(defun c:x4 (/ _PromptWithDefault LWPoly Line GroupByNum lst p1 p2)
  ;; Lee Mac  ~  30.03.10

  (defun _PromptWithDefault (f arg d)
    (cond ((apply f arg)) (d)))
 
  (defun LWPoly (lst cls)
    (entmakex (append (list (cons 0 "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length lst))
                            (cons 70 cls))
                      (mapcar (function (lambda (p) (cons 10 p))) lst))))

  (defun Line (p1 p2)
    (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))

  (defun GroupByNum (lst num / rtn)
    (setq rtn nil)
 
    (if lst
      (cons (reverse
              (repeat num
                (progn
                  (setq rtn (cons (car lst) rtn)
                        lst (cdr lst))
                  rtn)))

            (GroupByNum lst num))))
 

  (setq p2 (_PromptWithDefault (function getcorner)
             (list "\nklik titik awal <10,5,0> : "
                   (setq p1 (_PromptWithDefault (function getpoint)
                              '("\nklik titik awal <0,0,0> : ") '(0 0 0)))) '(10 5 0)))

  (setq lst
         
    (  (lambda (data)
         (mapcar
           (function
             (lambda (funcs)
               (mapcar
                 (function
                   (lambda (func)
                     ((eval func) data)))

                 funcs)))

           '((caar   cadar)
             (caadr  cadar)
             (caadr cadadr)
             (caar  cadadr))))

      (list p1 p2)))

  (LWPoly lst 1)
  (apply (function mapcar) (cons (function Line) (GroupByNum lst 2)))

  (princ))
 


Title: Re: What wrong with this code
Post by: Lee Mac on March 30, 2010, 10:40:03 AM

Quote from: Adesu on March 30, 2010, 10:29:15 AM

Your code good too,thanks.

You're welcome Adesu - mine is probably not practical for your situation, but I wanted to experiment with the coding   ;-)