Author Topic: New WCS  (Read 2232 times)

0 Members and 1 Guest are viewing this topic.

Fabricio28

  • Swamp Rat
  • Posts: 666
New WCS
« on: May 02, 2013, 04:33:16 PM »
Hello Guys,
I have a doubt, and I need some help.

I used the command DVIEW-twist to rotate my drawing.
Now WCS was changed.
I would like to draw a straight line (F8) in the  WCS World (default), standing in the new WCS.

Is it possible??

Regards
« Last Edit: May 02, 2013, 04:38:39 PM by FABRICIO28 »

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: New WCS
« Reply #1 on: May 02, 2013, 05:52:06 PM »
This?
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / p1 p2 )
  2.     (if (setq p1 (getpoint "\nP1: "))
  3.         (progn
  4.             (setq p1 (trans p1 1 2))
  5.             (princ "\nP2: ")
  6.             (while (= 5 (car (setq p2 (grread t 4))))
  7.                 (redraw)
  8.                 (setq p2 (mapcar '- (trans (cadr p2) 1 2) p1))
  9.                 (grvecs
  10.                     (list 256 '(0.0 0.0)
  11.                         (if (< (abs (car p2)) (abs (cadr p2)))
  12.                             (list 0.0 (cadr p2))
  13.                             (list (car p2) 0.0)
  14.                         )
  15.                     )
  16.                     (list
  17.                         (list 1.0 0.0 0.0 (car  p1))
  18.                         (list 0.0 1.0 0.0 (cadr p1))
  19.                         (list 0.0 0.0 1.0 0.0)
  20.                        '(0.0 0.0 0.0 1.0)
  21.                     )
  22.                 )
  23.             )
  24.         )
  25.     )
  26.     (redraw) (princ)
  27. )

Fabricio28

  • Swamp Rat
  • Posts: 666
Re: New WCS
« Reply #2 on: May 07, 2013, 02:21:23 PM »
Excellent, Lee!!
You understood better than my friends portuguese my request.

Just one more thing...
I can't modify the code to insert polyline on P1 and P2.

Coul you help me out, please?

Thanks

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: New WCS
« Reply #3 on: May 07, 2013, 05:26:59 PM »
This may do your basic pline unless you intend to entmake the pline.
Code: [Select]
(defun c:test ()
  (command "_PLINE")
  (while (> (getvar "CMDACTIVE") 0)
    (command pause)
  )
  (princ)
)
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: 12905
  • London, England
Re: New WCS
« Reply #4 on: May 07, 2013, 07:27:33 PM »
Excellent, Lee!!
You understood better than my friends portuguese my request.

 :-)

Just one more thing...
I can't modify the code to insert polyline on P1 and P2.

Coul[d] you help me out, please?

Try the following:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test ( / p1 p2 zv )
  2.     (if (setq p1 (getpoint "\nP1: "))
  3.         (progn
  4.             (setq p1 (trans p1 1 2))
  5.             (princ "\nP2: ")
  6.             (while (= 5 (car (setq p2 (grread t 4))))
  7.                 (redraw)
  8.                 (setq p2 (mapcar '- (trans (cadr p2) 1 2) p1))
  9.                 (grvecs
  10.                     (list 256 '(0.0 0.0)
  11.                         (if (< (abs (car p2)) (abs (cadr p2)))
  12.                             (list 0.0 (cadr p2))
  13.                             (list (car p2) 0.0)
  14.                         )
  15.                     )
  16.                     (list
  17.                         (list 1.0 0.0 0.0 (car  p1))
  18.                         (list 0.0 1.0 0.0 (cadr p1))
  19.                         (list 0.0 0.0 1.0 0.0)
  20.                        '(0.0 0.0 0.0 1.0)
  21.                     )
  22.                 )
  23.             )
  24.             (if (= 3 (car p2))
  25.                 (progn
  26.                     (setq p2 (trans (cadr p2) 1 2)
  27.                           zv (trans (getvar 'viewdir) 1 0 t)
  28.                     )
  29.                     (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1))))
  30.                         (setq p2 (list (car p1) (cadr p2)))
  31.                         (setq p2 (list (car p2) (cadr p1)))
  32.                     )
  33.                     (entmake
  34.                         (list
  35.                            '(000 . "LWPOLYLINE")
  36.                            '(100 . "AcDbEntity")
  37.                            '(100 . "AcDbPolyline")
  38.                            '(090 . 2)
  39.                            '(070 . 0)
  40.                             (cons 010 (trans p1 2 zv))
  41.                             (cons 010 (trans p2 2 zv))
  42.                             (cons 210 zv)
  43.                         )
  44.                     )
  45.                 )
  46.             )
  47.         )
  48.     )
  49.     (redraw) (princ)
  50. )

However, for practical purposes Object Snap would be required, and so you would likely need to use something like this instead:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:test2 ( / p1 p2 zv )
  2.     (if
  3.         (and
  4.             (setq p1 (getpoint "\nP1: "))
  5.             (setq p2 (getpoint "\nP2: " p1))
  6.         )
  7.         (progn
  8.             (setq p1 (trans p1 1 2)
  9.                   p2 (trans p2 1 2)
  10.                   zv (trans (getvar 'viewdir) 1 0 t)
  11.             )
  12.             (if (< (abs (- (car p2) (car p1))) (abs (- (cadr p2) (cadr p1))))
  13.                 (setq p2 (list (car p1) (cadr p2)))
  14.                 (setq p2 (list (car p2) (cadr p1)))
  15.             )
  16.             (entmake
  17.                 (list
  18.                    '(000 . "LWPOLYLINE")
  19.                    '(100 . "AcDbEntity")
  20.                    '(100 . "AcDbPolyline")
  21.                    '(090 . 2)
  22.                    '(070 . 0)
  23.                     (cons 010 (trans p1 2 zv))
  24.                     (cons 010 (trans p2 2 zv))
  25.                     (cons 210 zv)
  26.                 )
  27.             )
  28.         )
  29.     )
  30.     (princ)
  31. )

Fabricio28

  • Swamp Rat
  • Posts: 666
Awesome!!
« Reply #5 on: May 08, 2013, 07:46:11 AM »
It's impressive your code Mr. Lee Mac.
Just amazing!!

I'm astonished.

Thank you very much.
 :-D

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: New WCS
« Reply #6 on: May 08, 2013, 08:00:47 AM »
You are too kind Fabricio  :-)

GISDUDE

  • Guest
Re: New WCS
« Reply #7 on: May 09, 2013, 03:15:37 PM »
LEE,
You 'DA MAN! :-D

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: New WCS
« Reply #8 on: May 09, 2013, 07:21:35 PM »
lol, thanks  8-)