« previous next »
Pages: 1 2 3 [4] 5 |   Go Down

Author Topic: Copy and rotate (kopieren und drehen)  (Read 25564 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #45 on: September 25, 2012, 12:44:14 AM »
No need to redefine point with option "P" after multiple "U" undoes... LSP finally modified and attached here... So 7 downloads should update their codes with my code posted at the end of page 2 or re-download mcr.lsp from here...

There was 12 downloads before added copy-array option - now replaced attached mcr.lsp

T H E  E N D

M.R.
« Last Edit: October 06, 2012, 03:26:27 PM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Hugo

  • Bull Frog
  • Posts: 430
Re: Copy and rotate (kopieren und drehen)
« Reply #46 on: September 25, 2012, 03:17:17 AM »
super Thanks

Have changed these lines, I save a few clicks.
anyway since I just copy and move blocks and texts must.
Thanks again.

Code: [Select]
(setq s (car(entsel)));;(ssget "_:L"))
        (setq p (cdr(assoc 10 (entget s))));;(getpoint "\nPick base point : "))
super Danke 
Habe diese Zeilen geändert, spar ich mir ein paar klicks.
da ich sowieso nur blöcke und Texte kopieren und verschieben muss.
Danke nochmal.
Logged

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #47 on: September 25, 2012, 06:29:05 AM »
Hugo, you were probably working in WCS, so you didn't see how "U" undo option messes base points in some relative UCS... This is now also possible, just change UCS and you can work like you should - press few times undo and you can also continue from where you undo with normal actions...

My apology, I didn't saw it earlier, you have to download again... :mrgreen:
M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Hugo

  • Bull Frog
  • Posts: 430
Re: Copy and rotate (kopieren und drehen)
« Reply #48 on: September 25, 2012, 06:59:05 AM »
Yes I have tested works great
Thank you   :-) :-) :-)

Ja habe ich getestet funktioniert super
Danke
Logged

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #49 on: October 06, 2012, 12:18:21 AM »
Added one more option - "A" - copy-array (request by member from www.cadtutor.net)...

Regards, M.R.
c",)
(I saw this from pBe - nice trick with characters pBe) {8|O)
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #50 on: October 06, 2012, 06:28:17 AM »
There was some bug when using "U" undo option that I noticed only this morning - hope that now it's fixed... Please, report me if you find something strange (problem was with remembering base point after move sequence and undo sequence)...

Sincerely, M.R.
 :-)
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #51 on: October 08, 2012, 09:43:19 AM »
I've added new options for rotate-previous - "E" key and rotate-array - "Y" key, but as I didn't know how to obtain angle after rotate command I used trick with grread, so with these 2 options you have to be careful - input of rotation angles has to be made only with mouse picked point... In order to get rotate-previous, you have to use firstly "R" rotate option with mouse input and "Y" rotate-array you do it directly also with mouse input... Everything is noted in prompts when routine is running...

So until someone find out how to get rotation angle (to pass it into variable), this version with grread trick can do the job, only thing is I don't know how useful this is so it's strongly suggested that you keep also previously posted mcr.lsp

Now, here is new mcr-new.lsp

M.R.
« Last Edit: October 08, 2012, 10:21:02 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #52 on: October 08, 2012, 02:18:25 PM »
It seems that one more mouse click is necessary... So this is my final version - everything is prompted when routine is executed...

M.R.

c',}
« Last Edit: December 18, 2012, 08:28:28 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #53 on: October 08, 2012, 04:22:05 PM »
Sorry, I've noticed my mistake when undo after rotate-array - so I've added to remember selection set in undo... Now it's all OK...

Here is complete code :
Code - Auto/Visual Lisp: [Select]
  1. (defun c:mcr ( / *error* b c cmde s ang p l sss p1 p2 v ) ; l , sss - lexical globals
  2.   (defun *error* (msg)
  3.     (if b (setvar 'BLIPMODE b))
  4.     (if c (setvar 'COPYMODE c))
  5.     (if cmde (setvar 'CMDECHO cmde))
  6.     (if msg (prompt msg))
  7.     (princ)
  8.   )
  9.   (if (setq b (getvar 'BLIPMODE)) (setvar 'BLIPMODE 1))
  10.   (if (setq cmde (getvar 'CMDECHO)) (setvar 'CMDECHO 0))
  11.   (if (setq c (getvar 'COPYMODE)) (setvar 'COPYMODE 1))
  12.   (defun do_C nil
  13.     (prompt "\nNext point : ")
  14.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  15.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  16.     (setq sss (cons s sss))
  17.     (entdel (entlast))
  18.     (vl-cmdf "_.undo" "m")
  19.     (setvar 'cmdecho 1)
  20.     (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  21.     (setq p1 (getvar 'LASTPOINT))
  22.     (vl-cmdf "_.move" s "" "_non" (getvar 'LASTPOINT) "_non" "\\")
  23.     (setq p2 (getvar 'LASTPOINT))
  24.     (setvar 'cmdecho 0)
  25.     (setq l (cons (getvar 'LASTPOINT) l))
  26.     (setq v (mapcar '- p2 p1))
  27.   )
  28.   (defun do_CC nil
  29.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  30.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  31.     (setq sss (cons s sss))
  32.     (entdel (entlast))
  33.     (vl-cmdf "_.undo" "m")
  34.     (setvar 'cmdecho 1)
  35.     (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  36.     (if v
  37.       (vl-cmdf "_.move" s "" "_non" (getvar 'LASTPOINT) "_non" (mapcar '+ (getvar 'LASTPOINT) v))
  38.     )
  39.     (setvar 'cmdecho 0)
  40.     (setq l (cons (getvar 'LASTPOINT) l))
  41.   )
  42.   (defun do_CCC ( / n k kk pt d )
  43.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  44.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  45.     (setq sss (cons s sss))
  46.     (entdel (entlast))
  47.     (vl-cmdf "_.undo" "m")
  48.     (initget 7)
  49.     (setq n (getint "\nEnter number of array items - (spaces) : "))
  50.     (setvar 'cmdecho 1)
  51.     (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  52.     (vl-cmdf "_.move" s "" "_non" (if llp (setq lp llp) (setq lp (getvar 'LASTPOINT))) "\\")
  53.     (setvar 'cmdecho 0)
  54.     (setq lllp (mapcar '- (setq llp (getvar 'LASTPOINT)) lp))
  55.     (setq k (float n))
  56.     (setq d (/ (distance lllp '(0.0 0.0 0.0)) k))
  57.     (prompt "\nUnit distance is : ") (princ (rtos d 2 8)) (getstring "\t ENTER TO CONTINUE")
  58.     (setq kk 0.0)
  59.     (repeat (- n 1)
  60.       (setq pt (mapcar '- lp (mapcar '* (list (* (setq kk (1+ kk)) (/ 1.0 k)) (* kk (/ 1.0 k)) (* kk (/ 1.0 k))) lllp)))
  61.       (vl-cmdf "_.copy" s "" "_non" lp "_non" pt)
  62.     )
  63.     (setvar 'LASTPOINT llp)
  64.     (setq l (cons llp l))
  65.   )
  66.   (defun do_M nil
  67.     (prompt "\nNext point : ")
  68.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  69.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  70.     (setq sss (cons s sss))
  71.     (entdel (entlast))
  72.     (vl-cmdf "_.undo" "m")
  73.     (setvar 'cmdecho 1)
  74.     (setq p1 (getvar 'LASTPOINT))
  75.     (vl-cmdf "_.move" s "" "_non" (if llp (setq lp llp) (setq lp (getvar 'LASTPOINT))) "\\")
  76.     (setq p2 (getvar 'LASTPOINT))
  77.     (setvar 'cmdecho 0)
  78.     (setq l (cons (getvar 'LASTPOINT) l))
  79.     (setq v (mapcar '- p2 p1))
  80.   )
  81.   (defun do_MM nil
  82.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  83.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  84.     (setq sss (cons s sss))
  85.     (entdel (entlast))
  86.     (vl-cmdf "_.undo" "m")
  87.     (setvar 'cmdecho 1)
  88.     (if v
  89.       (vl-cmdf "_.move" s "" "_non" (getvar 'LASTPOINT) "_non" (mapcar '+ (getvar 'LASTPOINT) v))
  90.     )
  91.     (setvar 'cmdecho 0)
  92.     (setq l (cons (getvar 'LASTPOINT) l))
  93.   )
  94.   (defun do_MI nil
  95.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  96.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  97.     (setq sss (cons s sss))
  98.     (entdel (entlast))
  99.     (vl-cmdf "_.undo" "m")
  100.     (setvar 'cmdecho 1)
  101.     (vl-cmdf "_.mirror" s "" "_non" (if llp llp (setq lp (getvar 'LASTPOINT))) "_non" "\\" "\\")
  102.     (setvar 'cmdecho 0)
  103.   )
  104.   (defun do_R ( / lo g )
  105.     (setq lo T)
  106.     (while lo
  107.       (prompt "\nLEFT MOUSE CLICK FOR <MOUSE INPUT>; RIGHT MOUSE CLICK FOR <KEYBOARD INPUT>")
  108.       (setq g (grread nil 14 0))
  109.       (cond
  110.         ((eq (car g) 3) (do_RM))
  111.         ((or (eq (car g) 25) (eq (car g) 11)) (do_RK))
  112.       )
  113.     )
  114.   )
  115.   (defun do_RM ( / pt osm pola )
  116.     (setq osm (getvar 'OSMODE))
  117.     (setvar 'OSMODE 0)
  118.     (setq pola (getvar 'POLARANG))
  119.     (setvar 'POLARANG 0.0)
  120.     (prompt "\nAngle in decimal degrees <input angle with mouse> : ")
  121.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  122.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  123.     (setq sss (cons s sss))
  124.     (entdel (entlast))
  125.     (vl-cmdf "_.undo" "m")
  126.     (setvar 'cmdecho 1)
  127.     (vl-cmdf "_.rotate" s "" "_non" (setq pt (if l (car l) (getvar 'LASTPOINT))) "\\")
  128.     (vl-cmdf "_.line" "_non" pt "_non" (cadr (grread 1)) "")
  129.     (setvar 'cmdecho 0)
  130.     (setq ang (atof (rtos (cvunit (getvar 'LASTANGLE) "radians" "degrees"))))
  131.     (setvar 'LASTPOINT pt)
  132.     (setvar 'OSMODE osm)
  133.     (setvar 'POLARANG pola)
  134.     (entdel (entlast))
  135.     (setq lo nil)
  136.   )
  137.   (defun do_RK ( / pt osm pola )
  138.     (setq osm (getvar 'OSMODE))
  139.     (setvar 'OSMODE 0)
  140.     (setq pola (getvar 'POLARANG))
  141.     (setvar 'POLARANG 0.0)
  142.     (initget 3)
  143.     (setq ang (getreal "\nAngle in decimal degrees <input angle with keyboard> : "))
  144.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  145.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  146.     (setq sss (cons s sss))
  147.     (entdel (entlast))
  148.     (vl-cmdf "_.undo" "m")
  149.     (setvar 'cmdecho 1)
  150.     (vl-cmdf "_.rotate" s "" "_non" (setq pt (if l (car l) (getvar 'LASTPOINT))) ang)
  151.     (setvar 'cmdecho 0)
  152.     (setvar 'LASTPOINT pt)
  153.     (setvar 'OSMODE osm)
  154.     (setvar 'POLARANG pola)
  155.     (setq lo nil)
  156.   )
  157.   (defun do_RT nil
  158.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  159.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  160.     (setq sss (cons s sss))
  161.     (entdel (entlast))
  162.     (vl-cmdf "_.undo" "m")
  163.     (setvar 'cmdecho 1)
  164.     (vl-cmdf "_.rotate" s "" "_non" (if l (car l) (getvar 'LASTPOINT)) 90)
  165.     (setvar 'cmdecho 0)
  166.   )
  167.   (defun do_RR nil
  168.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  169.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  170.     (setq sss (cons s sss))
  171.     (entdel (entlast))
  172.     (vl-cmdf "_.undo" "m")
  173.     (setvar 'cmdecho 1)
  174.     (vl-cmdf "_.rotate" s "" "_non" (if l (car l) (getvar 'LASTPOINT)) "")
  175.     (setvar 'cmdecho 0)
  176.   )
  177.   (defun do_RRR nil
  178.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  179.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  180.     (setq sss (cons s sss))
  181.     (entdel (entlast))
  182.     (vl-cmdf "_.undo" "m")
  183.     (setvar 'cmdecho 1)
  184.     (vl-cmdf "_.rotate" s "" "_non" (if l (car l) (getvar 'LASTPOINT)) (if ang (setq ang (- ang)) 0))
  185.     (setvar 'cmdecho 0)
  186.   )
  187.   (defun do_RRRR ( / lo g )
  188.     (setq lo T)
  189.     (while lo
  190.       (prompt "\nLEFT MOUSE CLICK FOR <MOUSE INPUT>; RIGHT MOUSE CLICK FOR <KEYBOARD INPUT>")
  191.       (setq g (grread nil 14 0))
  192.       (cond
  193.         ((eq (car g) 3) (do_RRRRM))
  194.         ((or (eq (car g) 25) (eq (car g) 11)) (do_RRRRK))
  195.       )
  196.     )
  197.   )
  198.   (defun do_RRRRM ( / loo g pt osm pola ss entl n k kk d )
  199.     (setq osm (getvar 'OSMODE))
  200.     (setvar 'OSMODE 0)
  201.     (setq pola (getvar 'POLARANG))
  202.     (setvar 'POLARANG 0.0)
  203.     (prompt "\nAngle in decimal degrees <input angle with mouse> : ")
  204.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  205.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  206.     (setq sss (cons s sss))
  207.     (entdel (entlast))
  208.     (vl-cmdf "_.undo" "m")
  209.     (setvar 'cmdecho 1)
  210.     (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  211.     (vl-cmdf "_.rotate" s "" "_non" (setq pt (if l (car l) (getvar 'LASTPOINT))) "\\")
  212.     (vl-cmdf "_.line" "_non" pt "_non" (cadr (grread 1)) "")
  213.     (setvar 'cmdecho 0)
  214.     (setvar 'LASTPOINT pt)
  215.     (setq ang (atof (rtos (cvunit (getvar 'LASTANGLE) "radians" "degrees"))))
  216.     (entdel (entlast))
  217.     (setq loo T)
  218.     (while loo
  219.       (prompt "\nLEFT MOUSE CLICK FOR ANGLE LESS THAN 180 DEGREE; RIGHT MOUSE CLICK FOR ANGLE MORE THAN 180 DEGREE")
  220.       (setq g (grread nil 14 0))
  221.       (cond
  222.         ((eq (car g) 3) (setq loo nil))
  223.         ((or (eq (car g) 25) (eq (car g) 11)) (if (not (minusp ang)) (setq ang (- ang 360.0)) (setq ang (+ ang 360.0))) (setq loo nil))
  224.       )
  225.     )
  226.     (setq ss (ssadd))
  227.     (initget 6)
  228.     (setq n (getint "\nEnter number of array items - (spaces) <ENTER-rotate-1copy> : "))
  229.     (if (not (null n))
  230.       (progn
  231.         (setq k (float n))
  232.         (setq d (/ ang k))
  233.         (prompt "\nUnit angle is : ") (princ (rtos d 2 8)) (prompt "\t ENTER TO CONTINUE")
  234.         (vl-cmdf "\\")
  235.         (setq kk 0)
  236.         (repeat (- n 1)
  237.           (setq kk (1+ kk))
  238.           (if (= kk 1)
  239.             (progn
  240.               (setq entl (entlast))
  241.               (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  242.               (while (setq entl (entnext entl))
  243.                 (ssadd entl ss)
  244.               )
  245.               (setvar 'cmdecho 1)
  246.               (vl-cmdf "_.rotate" s "" "_non" (getvar 'LASTPOINT) (* (* -1.0 (/ 1.0 k)) ang))
  247.               (setvar 'cmdecho 0)
  248.             )
  249.             (progn
  250.               (setvar 'cmdecho 1)
  251.               (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  252.               (vl-cmdf "_.rotate" s "" "_non" (getvar 'LASTPOINT) (* (* -1.0 (/ 1.0 k)) ang))
  253.               (setvar 'cmdecho 0)
  254.             )
  255.           )
  256.         )
  257.       )
  258.     )
  259.     (if (/= (sslength ss) 0) (setq s ss))
  260.     (setvar 'LASTPOINT pt)
  261.     (setvar 'OSMODE osm)
  262.     (setvar 'POLARANG pola)
  263.     (setq lo nil)
  264.   )
  265.   (defun do_RRRRK ( / pt osm pola ss entl n k kk d )
  266.     (setq osm (getvar 'OSMODE))
  267.     (setvar 'OSMODE 0)
  268.     (setq pola (getvar 'POLARANG))
  269.     (setvar 'POLARANG 0.0)
  270.     (initget 3)
  271.     (setq ang (getreal "\nAngle in decimal degrees <input angle with keyboard> : "))
  272.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  273.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  274.     (setq sss (cons s sss))
  275.     (entdel (entlast))
  276.     (vl-cmdf "_.undo" "m")
  277.     (setvar 'cmdecho 1)
  278.     (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  279.     (vl-cmdf "_.rotate" s "" "_non" (if l (car l) (getvar 'LASTPOINT)) ang)
  280.     (setvar 'cmdecho 0)
  281.     (setq ss (ssadd))
  282.     (initget 6)
  283.     (setq n (getint "\nEnter number of array items - (spaces) <ENTER-rotate-1copy> : "))
  284.     (if (not (null n))
  285.       (progn
  286.         (setq k (float n))
  287.         (setq d (/ ang k))
  288.         (prompt "\nUnit angle is : ") (princ (rtos d 2 8)) (prompt "\t ENTER TO CONTINUE")
  289.         (vl-cmdf "\\")
  290.         (setq kk 0)
  291.         (repeat (- n 1)
  292.           (setq kk (1+ kk))
  293.           (if (= kk 1)
  294.             (progn
  295.               (setq entl (entlast))
  296.               (setvar 'cmdecho 1)
  297.               (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  298.               (setvar 'cmdecho 0)
  299.               (while (setq entl (entnext entl))
  300.                 (ssadd entl ss)
  301.               )
  302.               (setvar 'cmdecho 1)
  303.               (vl-cmdf "_.rotate" s "" "_non" (getvar 'LASTPOINT) (* (* -1.0 (/ 1.0 k)) ang))
  304.               (setvar 'cmdecho 0)
  305.             )
  306.             (progn
  307.               (setvar 'cmdecho 1)
  308.               (vl-cmdf "_.copy" s "" "_non" (getvar 'LASTPOINT) "_non" (getvar 'LASTPOINT))
  309.               (vl-cmdf "_.rotate" s "" "_non" (getvar 'LASTPOINT) (* (* -1.0 (/ 1.0 k)) ang))
  310.               (setvar 'cmdecho 0)
  311.             )
  312.           )
  313.         )
  314.       )
  315.     )
  316.     (if (/= (sslength ss) 0) (setq s ss))
  317.     (setq l (cons (trans (getvar 'LASTPOINT) 0 1) l))
  318.     (setvar 'OSMODE osm)
  319.     (setvar 'POLARANG pola)
  320.     (setq lo nil)
  321.   )
  322.   (defun do_U nil
  323.     (vl-cmdf "_.undo" "b")
  324.     (setq s (car sss))
  325.     (setvar 'LASTPOINT (car l))
  326.     (setq l (cdr l))
  327.     (setq sss (cdr sss))
  328.   )
  329.   (defun do_AL nil
  330.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  331.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  332.     (setq sss (cons s sss))
  333.     (entdel (entlast))
  334.     (vl-cmdf "_.undo" "m")
  335.     (setvar 'cmdecho 1)
  336.     (vl-cmdf "._point" "_non" (car l))
  337.     (vl-cmdf "_.align" (ssadd (setq p (entlast)) s) "")
  338.     (while (< 0 (getvar 'cmdactive))
  339.       (vl-cmdf "\\")
  340.     )
  341.     (setvar 'cmdecho 0)
  342.     (setq l (cons (trans (cdr (assoc 10 (entget p))) 0 1) l))
  343.     (entdel p)
  344.     (setvar 'LASTPOINT (car l))
  345.   )
  346.   (defun do_L nil
  347.     (vl-cmdf "_.point" "_non" (if l (car l) (getvar 'LASTPOINT)))
  348.     (setq l (cons (trans (cdr (assoc 10 (entget (entlast)))) 0 1) l))
  349.     (setq sss (cons s sss))
  350.     (entdel (entlast))
  351.     (vl-cmdf "_.undo" "m")
  352.     (setvar 'cmdecho 1)
  353.     (vl-cmdf "._scale" (car sss) "" "_non" (car l))
  354.     (while (< 0 (getvar 'cmdactive))
  355.       (vl-cmdf "\\")
  356.     )
  357.     (setvar 'cmdecho 0)
  358.   )
  359.   (defun mcr ( / loop gr sss l lp llp lllp )
  360.     (setq loop T)
  361.     (if (not (eq s nil))
  362.       (while loop
  363.         (prompt "\n\"S\" key for new selection and basepoint; \"P\" key for base point; \t\"C\" key for copy; \"W\" key for copy-array; \"D\" key for copy-continuous; \"A\" key for align; \"M\" key for move; \"N\" key for move-continuous; \t\"I\" key for mirror; \t\"R\" key for rotate; \"T\" key for rotate-again; \"E\" key for rotate-previous; \"Y\" key for rotate-array; \"L\" key for scale; \"TAB\" key for rotate by 90 degree; \"U\" key for undo; ESC, right mouse click to end")
  364.         (setq gr (grread nil 14 0))
  365.         (cond
  366.           ((or (equal gr '(2 115)) (equal gr '(2 83))) (progn (setq s nil) (mcr)))
  367.           ((or (equal gr '(2 112)) (equal gr '(2 80))) (progn (setq p (getpoint "\nPick base point : ")) (setq llp nil) (setvar 'LASTPOINT p)))
  368.           ((or (equal gr '(2 99)) (equal gr '(2 67))) (do_C))
  369.           ((or (equal gr '(2 100)) (equal gr '(2 68))) (do_CC))
  370.           ((or (equal gr '(2 119)) (equal gr '(2 87))) (do_CCC))
  371.           ((or (equal gr '(2 109)) (equal gr '(2 77))) (do_M))
  372.           ((or (equal gr '(2 110)) (equal gr '(2 78))) (do_MM))
  373.           ((or (equal gr '(2 105)) (equal gr '(2 73))) (do_MI))
  374.           ((or (equal gr '(2 114)) (equal gr '(2 82))) (do_R))
  375.           ((or (equal gr '(2 116)) (equal gr '(2 84))) (do_RR))
  376.           ((or (equal gr '(2 101)) (equal gr '(2 69))) (do_RRR))
  377.           ((or (equal gr '(2 121)) (equal gr '(2 89))) (do_RRRR))
  378.           ((or (equal gr '(2 97)) (equal gr '(2 65))) (do_AL))
  379.           ((or (equal gr '(2 108)) (equal gr '(2 76))) (do_L))
  380.           ((or (equal gr '(2 117)) (equal gr '(2 85))) (do_U))
  381.           ((equal gr '(2 9)) (do_RT))
  382.           ((or (equal gr '(2 27)) (eq (car gr) 25) (eq (car gr) 11)) (setq loop nil))
  383.         )
  384.       )
  385.       (progn
  386.         (setq s (ssget "_:L"))
  387.         (setq p (getpoint "\nPick base point : "))
  388.         (setvar 'LASTPOINT p)
  389.         (mcr)
  390.       )
  391.     )
  392.   )
  393.   (mcr)
  394.   (*error* nil)
  395. )
  396.  

M.R.
 8-)
« Last Edit: November 22, 2023, 01:39:21 PM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Hugo

  • Bull Frog
  • Posts: 430
Re: Copy and rotate (kopieren und drehen)
« Reply #54 on: October 09, 2012, 12:33:56 AM »
super Thanks
I can really use

super Danke
kann ich gut gebrauchen
Logged

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #55 on: October 09, 2012, 07:59:05 AM »
Quote from: Hugo on October 09, 2012, 12:33:56 AM
super Thanks
I can really use

super Danke
kann ich gut gebrauchen

Two variables haven't been localized, so now you can use it with full reliability...
Zwei Variablen wurden nicht lokalisiert, so jetzt können Sie es mit voller Zuverlässigkeit verwenden...

M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

thuphong

  • Guest
Re: Copy and rotate (kopieren und drehen)
« Reply #56 on: October 09, 2012, 09:16:32 AM »
Quote from: ribarm on October 09, 2012, 07:59:05 AM
Thank ribarm.
Why I click Right mouse for rotation is no active, but if (eq (car gr) 11)) is OK

Logged

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #57 on: October 09, 2012, 09:42:14 AM »
Quote from: thuphong on October 09, 2012, 09:16:32 AM
Quote from: ribarm on October 09, 2012, 07:59:05 AM
Thank ribarm.
Why I click Right mouse for rotation is no active, but if (eq (car gr) 11)) is OK

On my comp. right mouse click is recognized with (eq (car g) 25), but if you have problems with this and with value 11 it works for you, then you use what suits you best... With right mouse click you enter subfunction for keyboard input where all 360 degrees angles are allowed... If you haven't noticed (getvar 'LASTANGLE) returns always angle from -PI to PI, so rotate-array with mouse click is always by angle < 180 degree - if you really have the need for rotate-array I strongly suggest that you use keyboard input - full angles up to 360 degree...

M.R.
« Last Edit: October 09, 2012, 09:50:03 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3255
  • Marko Ribar, architect
Re: Copy and rotate (kopieren und drehen)
« Reply #58 on: October 09, 2012, 10:44:55 AM »
Here, I've updated code once more and finally - it should operate OK and with your case - value 11 of (car (grread)) for right mouse click... I've also included angles more than 180 degree in rotate-array with mouse input - had to add one more mouse click choice...

Regards, M.R.
 :-)
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

thuphong

  • Guest
Re: Copy and rotate (kopieren und drehen)
« Reply #59 on: October 09, 2012, 09:54:40 PM »
Quote from: ribarm on October 09, 2012, 10:44:55 AM
Here, I've updated code once more and finally - it should operate OK and with your case - value 11 of (car (grread)) for right mouse click... I've also included angles more than 180 degree in rotate-array with mouse input - had to add one more mouse click choice...

Regards, M.R.
 :-)
Thank verry much ribarm   
 :-D :-D
« Last Edit: October 09, 2012, 10:00:26 PM by thuphong »
Logged
Pages: 1 2 3 [4] 5 |   Go Up
« previous next »