CADsite forum

AutoCAD => Autolisp => Topic gestart door: Adrianus op vr 29 01 2016, 10:31:55

Titel: (OPGELOST:) COPY ROTEER
Bericht door: Adrianus op vr 29 01 2016, 10:31:55
Beste allen,
Ik heb via internet onderstaande Lisp gedownload.
Op zich werkt deze lisp ware het dat ik steed op ESC. moet drukken om definitief te kunnen roteren

Wat is er fout in deze lisp en is er iemand die dat kan herstellen?

Groet,
Adrianus

;;COPYROT.LSP Copyright 1998 HyperPics all rights reserved
;;
;;  Author:  Lee Ambrosius,
;;                HyperPics
;;              http://members.aol.com/HyperPics/Home.html           

;;COPYROT is a command to allow you to copy an object and then do
;;a rotate right after it. Once loaded just type in COPYROT to activate
;;the command. 

;;This is a great file to place inside of your ACAD.lsp file or use
;;it by itself.

;;  All documentation must stay with this Lips routine though.

;; Find and give me the Group nams in a lists
;; First string in list will be the last group created
(defun newgroups (/ GRPS OD GRP1 CHCKR GRPS GNAME)
  (setq OD (namedobjdict))
  (setq GRPS (dictnext OD "acad_group"))
  (while (/= CHCKR 3)
    (setq GRP1 (car GRPS))
    (setq GRPS (cdr GRPS))
    (setq chckr (car GRP1))
    (if (= chckr 3)
      (progn
        (setq NGROUPS (list (cdr GRP1)))
      )
    )
  )
  (while (/= GRPS nil)
    (setq GRP1 (car GRPS))
    (setq GRPS (cdr GRPS))
    (setq chckr (car GRP1))
    (if (= chckr 3)
      (progn
        (setq GNAME (cdr GRP1))
        (setq NGROUPS (cons GNAME NGROUPS))
      )
    )
  )
  (setq EXGNAME (car NGROUPS))
)

;;Error Tile
(defun MYERROR (S)
  (if (/= S "\nFunction cancelled" )
  (princ "\nEnding Copy Rotate..." )) 
  (command "-group" "e" "copier")
  (command "undo" "end")
  (command "u" "u")
  (setvar "CMDECHO" CMD)
  (setq *ERROR* OLDERR )
  (princ)
)

;; Main section of Copy Rotate
(defun c:COPYROT (/ SS1 PT1 PT2)
  (setq SS1 nil)
  (setq CMD (getvar "CMDECHO"))
  (setq OLDERR *ERROR*)
  (setq *ERROR* MYERROR)
  (command "undo" "begin")
  (setvar "CMDECHO" 0)
  (prompt "\nSelect Objects to Copy-Rotate: ")
  (setq SS1 (ssget))
  (command "-group" "" "copier" "" SS1 "")
  (setq PT1 (getpoint "\nFirst Point of displacement: "))
  (prompt "\Second Point of Displacment: ")
  (command "._copy" "g" "copier" "" PT1 pause)
  (setq PT2 (getvar "LASTPOINT"))
  (prompt "\nSelect Angle of Rotation: ")
  (command "._rotate" "last" "" PT2 pause)
  (command "-group" "e" "copier")
  (newgroups)
  (command "-group" "e" EXGNAME)
  (command "undo" "end")
  (setvar "CMDECHO" CMD)
  (redraw)
  (prompt "\nCopy Rotate complete....")
(princ)
) ;; End of Copy Rotate
(c:COPYROT)
Titel: Re: COPY ROTEER
Bericht door: EddyBeerke op vr 29 01 2016, 11:21:30
Probeer dit eens:
;;;Copy en Roteer met reference
(defun c:cr( / ss1 L1 L2 OsmodeOld *error*)
;; Error trap
  (defun *error* (errmsg)
    (princ "\nEr is een fout opgetreden!")
    (princ "\nReseting OSnap...\n")
    (setvar "OSMODE" OsmodeOld)
    (princ)
  );end defun *error*
 
  (setq OsmodeOld (getvar "OSMODE"))    ; Vraag de OSMODE op
  (setvar "OSMODE" 99)                  ; Verander de OSMODE in 99
  (setq ss1 (ssget))
  (setq L1 (getpoint "\nWijs Center/Rotatie punt (1) aan: "))
  (setq L2 (getpoint "\nWijs Referentie punt (2) aan: "))
  (command "COPY" ss1 "" L1 L1 "")
  (command "ROTATE" ss1 "" L1 "r" L1 L2 )
(setvar "OSMODE" OsmodeOld)            ; Zet de oude OSMODE terug
  (princ)
);;;Einde Copy en Roteer met reference
Titel: Re: COPY ROTEER
Bericht door: Adrianus op vr 29 01 2016, 12:17:33
Dank je Eddy,
Deze werkt wel. Heeft alleen het nadeel dat ik het gekopiéerde dan vervolgens weer moet verplaatsen.
Is daar ook een oplossing voor?

Met vriendelijke groet,
Adrianus
Titel: Re: COPY ROTEER
Bericht door: Adrianus op vr 29 01 2016, 20:32:38
Allen,

Bijgaand de volgende lisp die Copy en Move ook weer combineerd.

Groet,
Adrianus.

(defun c:mr  () (b-cmr "M")(princ))
(defun c:cr  () (b-cmr "C")(princ))
;***************************************************************************
; File         : mcr.lsp
; Date         : 20-9-03
; Function     : (B-CMR <MODE>)
; Purpose      : Copy+Rotate or Move+Rotate
; Arguments    : <MODE> = "C" -> Copy-rotate
;                       = "M" -> Move-rotate
; Written by   : J.J.Damstra
;***************************************************************************
(defun b-cmr (typ / ss1 temp p0 p1)
   (setq ss1 (ssget "I"))

   (command ".undo" "begin")
   (setq temp (getvar "CMDECHO"))(setvar "CMDECHO" 0)

   (if (not ss1)(setq ss1 (ssget)))
   (if ss1
      (progn
         (initget 1)
         (setq p0 (getpoint "\nBasepoint : "))
         
         (if (= typ "C")
            (progn
               (setq p1 (getpoint "\nTranslation or <ENTER>: " p0))
               (if (not p1)(setq p1 p0))
               (command ".copy" ss1 "" "0,0" "0,0")
            )
            (while (not p1)(setq p1 (getpoint "\nTranslation : " p0)))
         )

         (command ".move" ss1 "" p0 p1)
         (command ".rotate" ss1 "" p1 pause)
      )
      (princ "\nMsg> Nothing selected! ")
   )

   (command ".undo" "end")
   (setvar "CMDECHO" temp)
   (princ)
)
Titel: Re: (OPGELOST:) COPY ROTEER
Bericht door: EddyBeerke op ma 01 02 2016, 10:08:03
MOCORO van de expresstools zou ook kunnen werken...
Titel: Re: (OPGELOST:) COPY ROTEER
Bericht door: Adrianus op ma 01 02 2016, 16:16:46
Hoi Eddy,
MOCORO van Expresstools werkt ook goed. Maar deze lisp vindt ik iets prettiger werken.

M.vr.gr.,

Adrianus.
Titel: Re: (OPGELOST:) COPY ROTEER
Bericht door: EddyBeerke op do 04 02 2016, 23:35:22
Adrianus,
Ja als je aan mijn lisp iets toevoegd dan kun je ook de selectie verplaatsen.
Zoals uit de lisp blijkt laat je eigenlijk een copy achter... En werk je met de orginele objecten.

Voor de roteer actie kun je het ook eerst verplaatsen.
Dan krijg je zo iets:
(command "move" ss1 L1 (getpoint "nWijs nieuw lokatie aan: "))


Verstuurd vanaf mijn LG-E975 met Tapatalk