;|
DAP.LSP  Dynamic Array Polar

ends tedious iterations of ARRAY POLAR by providing dynamic adjustment
of *all* parameters of the native command:
  selected objects
  base point of selected objects
  rotation of objects
  center of array
  included angle (begin point and end point, or begin point and desired angle)
  number of copies (add one, subtract one, or enter new number)
and introducing...
  distance between copies, measured along arc
  angle between copies
  
Notes:
1) works most predictably if the objects to be copied are placed and aligned at the begin point
2) specifying any one of the end angle, the distance between copies, or the angle between 
     copies will override the other two (each sets a new end angle)


(c) 1999, 2008 by Bill Gilliss
bill [dot] gilliss [at] aya.yale.edu

Comments and suggestions always welcome.
    version 1.04: 11/15/1999 with Alfredo Medina's thoughtful suggestions
    version 2.00: 04/10/2008 error handling improved
                             internationalized
                             rotation reported
                             Distance option added and arc distance reported
                             Angle option added and angle distance reported
                             works regardless of current UCS
                             selecting arc or circle is now default for determining center point
|;


(defun c:dap (/ ss1 ang1 ang2  cent num a1 a2 reply 2pi rot
                 oldCmdEcho oldOsmode oldAngdir
                 *error* prologue epilogue getObjects getNumber getCent
                 getBegin getEnd setAngles drawArray getReply)


(setq num 1 
      ang1 0
      ang2 0
      ang4 0
      distoc nil
      )
          
(defun prologue ()
  (vl-load-com)
  (setq oldCmdEcho (getvar "cmdecho")) (setvar "cmdecho" 0)
  (setq oldOsmode (getvar "osmode"))   (setvar "osmode" 0)
  (setq oldAngbase (getvar "angbase")) (setvar "angbase" 0)
  (setq oldAngdir (getvar "angdir"))   (setvar "angdir" 0)
  (setq oldAunits (getvar "aunits"))   (setvar "aunits" 3)
  (setq oldOrtho  (getvar "orthomode"))
  (setq 2pi (* 2 pi))
  (setq rot "y")
  (setq rotMsg "yes")
  (setq distMsg nil)
  (setq angMsg nil)
);defun

;;==========================================
(defun epilogue ()
  (setvar "osmode" oldOsmode)
  (setvar "angdir" oldAngdir)
  (setvar "angbase" oldAngbase)
  (setvar "aunits" oldAunits)
  (setvar "orthomode" oldortho)
  (command "._undo" "end")
  (setvar "cmdecho" oldCmdEcho)
)

;;==========================================
(defun getObjects ()
  (prompt "Select object(s) to array: ")
  (setq ss1 (ssget))
);defun

;;==========================================
(defun getNumber ()
  (setq num 0)
  (while (< num 2)
     (initget 6) 
     (setq num (getint "\nNumber of copies in array <4>: "))
     (if (not num) (setq num 4))
     );while
  (reduceAng)
);defun

;;==========================================
(defun getDistance ( )
  (setq oldDist distOC)
  (setq distOC 0)
  (while (zerop distOC)
     (setq distOC (getdist (strcat "\nDistance along arc between copies <" (rtos oldDist) ">:")))
     (if (not distOC) (setq distOC oldDist))
     (setq distOC (abs distOC))
     );while
   (setq theta (/ radius distOC))
   (reduceNUM)
);defun

;;==========================================
(defun getCent ()
  (setq cent nil)
  (while (not cent)
    (initget "Point")
    (setq getArc (entsel "\nSelect arc or circle [or pick Point]: "))
    (if (or (= getARC "Point") (= getArc nil))
      (setq cent (getpoint "\nSelect center point for array: "))
      (progn
        (setq type (cdr (assoc 0 (entget (car getARC)))))
        (if (not (or (= type "ARC") (= type "CIRCLE")))
            (progn
               (setq cent nil)
               (prompt "That is not an arc or circle. Try picking a point.")
               )
            (progn
              (setq arcExtr (cdr (assoc 210 (entget (car getARC)))))
              (if (not (equal arcExtr (trans '(0.0 0.0 1.0) 1 0 T) 1e-8))
                  (progn
                    (prompt "\nObject is not parallel to current UCS. Align UCS to that")
                    (prompt "\nobject, or use the Point method to set the center point.")
                    (vlr-beep-reaction)
                    )
                  (progn
                    (setq obj (vlax-ename->vla-object (car getarc)))
                    (setq cent (trans (vlax-get obj "center") 0 1))
                    )
                  )
                )
              )
            ) 
       )
   )
);defun

;;==========================================
(defun getBase ()
    (setq base (getpoint "\nSelect rotation base point of object(s)/<Enter> for default: "))
);defun

;;==========================================
(defun getBegin ()
  (setq ang1 nil )
  (setvar "orthomode" 0)
  (while (not ang1)
         (initget 32)
         (setq beginPt (getpoint cent "\nStart of array angle: "))
         (setq ang1 (angle cent beginPt))
         )
  (setvar "orthomode" oldortho)
);defun

;;==========================================
(defun getEnd ()  ;; returns included angle from beginPt in radians
  (setq ang2 nil)
  (setvar "angbase" ang1)
  (setvar "orthomode" 0)
  (while (not ang2)
         (setvar "aunits" oldAunits)
         (initget 32)
         (setq ang2 (getangle cent "\nEnd of array angle (indicate point or enter angle): "))
         (setvar "aunits" 3) 
         )
  (setvar "orthomode" oldortho)
  (setvar "angbase" 0)
  (if (> ang2 pi) (setq ang2 (- (- 2pi (abs ang2)))))
  (if (= ang2 0) (setq ang2 2pi))
  );defun
  
;;==========================================
(defun getAngleBetween ()
  (setq ang4 nil)
  (setvar "aunits" 0)
  (while (not ang4)
         (initget 3)
         (setq ang4 (getreal "\nAngle between copies, in decimal degrees: "))
         (setq ang4 (abs (* pi (/ ang4 180))))
         )
  (setvar "aunits" 3) 
  (reduceNum)
  );defun

;;==========================================
(defun Flip_angles ()
     (if (minusp ang2) (setq toggle 1) (setq toggle -1))
     (setq ang2 (* toggle (- 2pi (abs ang2))))
);defun

;;==========================================
(defun drawArray ()

  (command "._redraw")
  
  (if (not base)
    (command "._array" ss1 "" "p" cent num ang2 rot)
    (command "._array" ss1 "" "p" "b" base cent num ang2 rot)
    )

  (setq radius (distance cent beginPt))
  (setq theta (/ (abs ang2) (1- num)))
  (setq distOC (* theta radius))
  (grdraw cent (polar cent ang1 radius) 3 1)
  (grdraw cent (polar cent (+ ang1 ang2) radius) 1 1)
  (report)
);defun


;;==========================================
(defun report ()
(prompt (strcat "\n" 
                "Num: " (itoa num) 
                 " | Rot: " rotMsg  
                 " | Ang: " (angtos theta oldAunits) "/" (angtos (* theta (1- num)) oldAunits)
                 " | Dist: " (rtos distOC) "/" (rtos (* distOC (1- num)))
                 )
                 )
)

;;==========================================
(defun reduceNum ()
  (if (>= (* (1- num) ang4) 2pi) 
      (progn
        (vlr-beep-reaction)
        (setq num (fix (/ 2pi ang4)))
        (alert "Number reduced to fit requested distance in 360 degrees.")
        )
  )
  (if (< num 2) (setq num 2))
)



;;==========================================
(defun reduceAng ( / toggle)  ;;don't copy onto or past the original
  (if (>= (abs(* (- num 1) ang4)) 2pi) 
      (progn
        (vlr-beep-reaction)
        (setq ang4 (/ 2pi num))
        (if (minusp ang2) (setq toggle -1) (setq toggle 1))
        (setq ang2 (* toggle (1- num) ang4))
        (alert "Angle reduced to fit requested number in 360 degrees.")
        )
  )
)

;;==========================================
(defun getReply ()
(initget  "Objects Base Center Start End Flip Rotate + - Number Distance Angle Help eXit")
(setq reply (getkword "\nObj/Base/Cen/Start/End/Flip/Rotate/+/-/Num/Dist/Angle/Help/eXit: "))

(cond

  (
  (= reply "Objects")
  (progn
     (command "._u")
     (getObjects)
     (drawArray)
     )
  )

  (
  (= reply "Base")
  (progn
     (command "._u")
     (getBase)
     (drawArray)
     )
  )

  (
  (= reply "Center")
  (progn
     (command "._u")
     (getCent)
     (drawArray)
     )
  )

  (
  
  (= reply "Start")
  (progn
     (command "._u")
     (getBegin)
     (drawArray)
     )
  )

  (
  (= reply "End")
  (progn
     (command "._u")
     (getEnd)
     (drawArray)
     )
  )

  (    
  (= reply "+")
  (progn
     (command "._u")
     (setq num (1+ num))
     (drawArray)
     )
   )

   (
   (= reply "-")
   (progn
     (command "._u")
     (setq num (1- num))
     (if (< num 2)
         (progn
           (prompt "\nToo few sets! Number reset to 2 (min).")
           (setq num 2)
           )
          )
      (drawArray)
     );progn
   )

   (
   (= reply "Number")
   (progn
      (command "._u")
      (getNumber)
      (drawArray)
      )
    )

    (
    (= reply "Distance")
    (progn
       (command "._u")
       (getDistance)
       (setq radius (distance cent beginpt))
       (setq theta (/ distOC radius))
       (if (minusp ang2) (setq toggle -1) (setq toggle 1)) ;preserve direction of former angle
       (setq ang2 (* toggle (1- num) theta))
       (drawArray)
       )
    )
    
    (
    (= reply "Angle")
    (progn
       (command "._u")
       (getAngleBetween) ;returns ang4 in radians
       (if (minusp ang2) (setq toggle -1) (setq toggle 1)) ;preserve direction of former angle
       (setq ang2 (* toggle (* ang4 (1- num))))
       (drawArray)
       )
    )

    (
    (= reply "Flip")
    (progn
      (command "._u")
      (Flip_angles)
      (drawArray)
      )
    )

    (
    (= reply "Rotate")
    (progn
      (command "._u")
      (if (= rot "y")
          (setq rot "n" rotMsg " no")
          (setq rot "y" rotMsg "yes")
          )
      (drawArray)
      )
    )

  (
(= reply "Help")
(alert
"Explanation of options:
  O  to change Objects to be arrayed
  B  to change rotation base point for rotated objects
  C  to change Center point of array
  S  to change Start point of array
  E  to change End point of array
  F  to Flip the angle (use arc complement)
  R  to Rotate/unrotate the copies
  +  to add one copy to the array
  -  to subtract one copy from the array
  N  to enter Number of copies directly
  A  to set the Angle between copies
  D  to set the Distance along arc between objects
  H  to redisplay this Help information
  X  [or ESC] to eXit the routine.")
    )

    (
    (= reply "eXit")
    (setq done T)
    )

    (
    (= reply nil)
    (setq done T)
    )
    );cond
(princ)
);defun

;;==========================================

(defun *error* (msg)
  (if
    (or
      (/= msg "Function cancelled")
      (= msg "quit / exit abort")
      )
    (princ)
    (princ (strcat "\nError: " msg))
    )
  (command) ;; to terminate AutoCAD's active ARRAY command
  (setvar "angdir" oldAngdir)
  (setvar "cmdecho" oldCmdEcho)
  (setvar "osmode" oldOsmode)
  (setvar "aunits" oldAunits)
  (setvar "orthomode" oldortho)
  (command "undo" "end")
  (command "._redraw")
  (princ)
);defun

;;========== main routine ====================
(command "._undo" "begin")
(prologue)
(getObjects)
(setq base nil) ;leave base an option for reply-loop
(getNumber)
(getCent)
(getBegin)
(getEnd)
(drawArray)

(setq done nil)
(while (not done)
   (getReply)
   )

(report)
(command "._redraw")
(epilogue)
(princ)
);defun  end of main routine

(prompt "DAP loaded. Enter  dap  to run.")
(princ)