« previous next »
Pages: [1] 2  All |   Go Down

Author Topic: What wrong with this code  (Read 5125 times)

0 Members and 1 Guest are viewing this topic.

Adesu

  • Guest
What wrong with this code
« 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
Logged

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: What wrong with this code
« Reply #1 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")
;;
Logged
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Krushert

  • Seagull
  • Posts: 13679
  • FREE BEER Tomorrow!!
Re: What wrong with this code
« Reply #2 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
Logged
I + XI = X is true ...  ... if you change your perspective.

I no longer CAD or Model, I just hang out here picking up the empties beer cans

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: What wrong with this code
« Reply #3 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)))
Logged

efernal

  • Bull Frog
  • Posts: 206
Re: What wrong with this code
« Reply #4 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)
)
Logged
e.fernal

Adesu

  • Guest
Re: What wrong with this code
« Reply #5 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)
)
Logged

Adesu

  • Guest
Re: What wrong with this code
« Reply #6 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)
  )
Logged

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: What wrong with this code
« Reply #7 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)
)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: What wrong with this code
« Reply #8 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))
 
Logged

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: What wrong with this code
« Reply #9 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)
)
Logged
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: What wrong with this code
« Reply #10 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 "_" )  :-)
Logged

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: What wrong with this code
« Reply #11 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:



from this
Logged
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.com • http://cadanalyst.slack.com • http://linkedin.com/in/cadanalyst

Adesu

  • Guest
Re: What wrong with this code
« Reply #12 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)
)
Logged

Adesu

  • Guest
Re: What wrong with this code
« Reply #13 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)
)
Logged

Adesu

  • Guest
Re: What wrong with this code
« Reply #14 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))
 
Logged
Pages: [1] 2  All |   Go Up
« previous next »