;Check all selected solids, find only autocad solid arrows and replace them with arrow blocks, extend lines to their point.  (uses LDRARO.DWG MKLAYR)
;
;	Author:
;		Henry C. Francis
;		425 N. Ashe St.
;		Southern Pines, NC 28387
;
;	http://www.pinehurst.net/hfrancis
;	e-mail hfrancis@pinehurst.net
;	All rights reserved.
;
(defun c:solaro ( / aross arssl count ab ac bc distl iang dimsc)
  (if c:mklayr nil (load"mklayr" "\nMKLAYER.LSP not found"))
  (c:svlayr)
  (setq oldosmode (getvar"osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if dimscl nil (load"dimscl"))
  (dimscl)
  (setq aross (ssget '((0 . "SOLID")(-4 . "<NOT")(0 . "INSERT")(-4 . "NOT>")))
        rplno 0
  );setq
  (if aross
    (setq arssl (sslength aross))
    (setq arssl 0)
  );if
  (setq count 0)
  (if aross 
    (princ "\nReplacing Arrowhead Solids, please wait")
    (princ "\nNo Arrowhead Solids found. ")
  );if
  (while
    (< count  arssl)
    (princ ".")
    (setq ename (ssname aross count)
          ent (entget ename))
    (progn
      (if(>(distance(cdr(assoc 10 ent))(cdr(assoc 11 ent)))0.02)
        (setq maxi(list(distance(cdr(assoc 10 ent))(cdr(assoc 11 ent))))))
      (if(>(distance(cdr(assoc 11 ent))(cdr(assoc 12 ent)))0.02)
        (if maxi
          (setq maxi(append(list(distance(cdr(assoc 11 ent))(cdr(assoc 12 ent))))maxi))
          (setq maxi(list(distance(cdr(assoc 11 ent))(cdr(assoc 12 ent)))))))
      (if(>(distance(cdr(assoc 12 ent))(cdr(assoc 13 ent)))0.02)
        (if maxi
          (setq maxi(append(list(distance(cdr(assoc 12 ent))(cdr(assoc 13 ent))))maxi))
          (setq maxi(list(distance(cdr(assoc 12 ent))(cdr(assoc 13 ent)))))))
      (if(>(distance(cdr(assoc 10 ent))(cdr(assoc 13 ent)))0.02)
        (if maxi
          (setq maxi(append(list(distance(cdr(assoc 10 ent))(cdr(assoc 13 ent))))maxi))
          (setq maxi(list(distance(cdr(assoc 10 ent))(cdr(assoc 13 ent)))))))
    );progn
    (if (and
          (equal(cdr(assoc 12 ent))(cdr(assoc 13 ent))0.001)
          (not(>(distance(cdr(assoc 10 ent))(cdr(assoc 11 ent)))(* 0.25 dimsc)))
          (not(>(distance(cdr(assoc 10 ent))(cdr(assoc 12 ent)))(* 0.25 dimsc)))
          (not(>(distance(cdr(assoc 11 ent))(cdr(assoc 12 ent)))(* 0.25 dimsc)))
          (<(* 2.000 (eval(append(list(read "min"))maxi)))(eval(append(list(read "max"))maxi)))
        );and
      (progn
        (setq ab (distance(cdr(assoc 10 ent))(cdr(assoc 11 ent)))
              ac (distance(cdr(assoc 10 ent))(cdr(assoc 12 ent)))
              bc (distance(cdr(assoc 11 ent))(cdr(assoc 12 ent)))
              a (cdr(assoc 10 ent))
              b (cdr(assoc 11 ent))
              c (cdr(assoc 12 ent))
              amc (polar a(angle a c)(/(distance a c)2))
              bmc (polar b(angle b c)(/(distance b c)2))
              amb (polar a(angle a b )(/(distance a b)2))
              elayr (cdr(assoc 8 ent))
        );setq
        (if(or(> ab ac)(equal ab ac 0.001))
          (if (> bc ac)
            (progn
              (setq pt1 b
                    pt2 amc
                    iang (angtos(angle b amc)0 6)
              );setq
            );progn
            (progn
              (setq pt1 a
                    pt2 bmc
                    iang (angtos(angle a bmc)0 6)
              );setq
            );progn
          );if
          (progn
            (setq pt1 c
                  pt2 amb
                  iang (angtos(angle c amb)0 6)
            );setq
          );progn
        );if
;(princ "\nPT1 has been set ")
        (command "erase" ename "")
;(princ "\nEntity has been deleted ")
        (setvar "clayer" elayr)
        (setq pt1 (trans pt1 0 1))
        (command ".insert" "ldraro" pt1 dimsc dimsc iang)
;(princ "\nBlock has been inserted ")
        (setq lsrch (list(cons -4 "<OR")(cons 10 pt2)(cons 11 pt2)(cons -4 "OR>")))
        (if
          (setq ldrss (ssget "x"(eval 'lsrch)))
          (progn
            (setq ename (ssname ldrss 0)
                  ent (entget ename))
            (cond
             (;and
                (equal(cdr(assoc 10 ent))pt2 0.0001)
              (progn
                (setq ent
                  (subst (cons 10 pt1)
                         (assoc 10 ent)
                         ent
                  );subst
                );setq
                (entmod ent)
              ));progn & cond
             (;and
                (equal(cdr(assoc 11 ent))pt2 0.0001)
              (progn
                (setq ent
                  (subst (cons 11 pt1)
                         (assoc 11 ent)
                         ent
                  );subst
                );setq
                (entmod ent)
              ));progn & cond
            );cond
          );progn
        );if
        (setq rplno (1+ rplno))
      );progn
;(princ "\n First IF failed ")
    );if
    (setq count (1+ count))
;(princ "\nCounter has been stepped ")
  );while
  (princ(strcat "\n"(itoa rplno)" arrow solids have been replaced."))
  (c:rslayr)
  (setvar "osmode" oldosmode)
  (princ)
);defun