;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2004
;;;>		   EDITED: 01-25-2006
;;;
(DEFUN c:imgprep ()
  (SETQ old_osmode (GETVAR "osmode"))
  (SETVAR "osmode" 0)
  (IF (OR
	(SSGET "x" '((0 . "image") (2 . "1x1")))
	(FINDFILE "1x1.bmp")
      ) ;_ end of or
    (PROGN
      (IF upoint
	nil
	(LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of if
      (SETQ imginspt (upoint 1 "" "Image lower left corner" nil nil))
      (SETQ imgbrc (upoint 1 "" "Width of image base" nil imginspt))
      (SETQ imgsize (DISTANCE imginspt
			      (LIST (CAR imgbrc) (CADR imginspt) 0)
		    ) ;_ end of distance
      ) ;_ end of setq
      (COMMAND ".image"
	       "a"
	       "1x1"
	       imginspt
	       (* 72.0 imgsize)
	       0
      ) ;_ end of command
      (SETQ imgent (ENTGET (ENTLAST)))
;;;      (ALERT
;;;	(STRCAT
;;;	  "\nYou must IMAGECLIP (POLYGONAL) this image before proceding."
;;;	  "\nOtherwise the image will blank out displaying its frame only."
;;;	  "\nIMAGECLIP / POLYGONAL is automatically started with this image."
;;;	  "\nUse at least 3 boundary points then run IMGARC on the image."
;;;	  "\nIMGARC will resize and reposition the image with your arc or circle.") ;_ end of strcat
;;;      ) ;_ end of alert
;;;      (COMMAND ".imageframe" "on")
;;;      (COMMAND ".imageclip" (ENTLAST) "New" "Polygonal")
      (PRINC)
    ) ;_ end of progn
    (PRINC
      "\nUnable to locate image 1x1.bmp. Make sure it exists and is on AutoCAD's support file search path. "
    ) ;_ end of princ
  ) ;_ end of if
  (SETVAR "osmode" old_osmode)
  (PRINC)
) ;_ end of defun
(DEFUN c:imgdonut ()
  (IF upoint
    nil
    (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
  ) ;_ end of if
  (IF uangle
    nil
    (LOAD "uangle" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of if
  (IF ureal
    nil
    (LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of if
  (IF ukword
    nil
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (WHILE
    (AND
      (SETQ arcoent (ENTSEL "Select arc or circle (outside edge)"))
      (NOT
	(OR
	  (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "ARC")
	  (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "CIRCLE")
	) ;_ end of or
      ) ;_ end of not
    ) ;_ end of and
  ) ;_ end of while
  (SETQ	arccenpnt (CDR (ASSOC 10 (ENTGET (CAR arcoent))))
	arcradval (CDR (ASSOC 40 (ENTGET (CAR arcoent))))
  ) ;_ end of setq
  (PRINC "Arc radius is ")
  (PRINC arcradval)
  (PRINC)
  (IF (NOT (FINDFILE "1x1.bmp"))
    (ALERT
      "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again."
    ) ;_ end of alert
    (PROGN
      (COMMAND ".image" "a" "1x1" arccenpnt 1 0)
      (SETQ imgent (ENTGET (ENTLAST)))
      (SETQ imgoradpt nil)
      (SETQ imgorad arcradval)
      (SETQ imgsang 0)
      (SETQ imgeang (* 2.0 PI))
      (SETQ pntcnt 5)
      (SETQ imgiradpt nil)
      (WHILE (OR (NOT imgiradpt) (>= imgirad imgorad))
	(SETQ imgiradpt	(upoint	1		    ""
				"Image donut inside radius"
				nil		    arccenpnt
			       ) ;_ end of upoint
 ;_ end of upoint
	) ;_ end of setq
	(SETQ imgirad (DISTANCE	(REVERSE (CDR (REVERSE arccenpnt)))
				(REVERSE (CDR (REVERSE imgiradpt)))
		      ) ;_ end of distance
	) ;_ end of setq
      ) ;_ end of while
      (SETQ angsure nil)
      (WHILE
	(NOT
	  (AND
	    (SETQ
	      cntincr (ureal 1
			     ""
			     "Angle increment for image clip boundary"
			     pntcnt
		      ) ;_ end of ureal
	    ) ;_ end of setq
	    (IF	(< cntincr pntcnt)
	      (PROGN
		(SETQ angsure
		       (ukword 1
			       "Yes No"
			       (STRCAT "Using and angle increment of "
				       (RTOS cntincr 2 4)
				       " may take awhile.  Are you sure?"
			       ) ;_ end of strcat
			       "No"
		       ) ;_ end of ukword
		) ;_ end of setq
		(IF (EQ angsure "No")
		  nil
		  T
		) ;_ end of if
	      ) ;_ end of progn
	      T
	    ) ;_ end of if
	  ) ;_ end of and
	) ;_ end of not
      ) ;_ end of while
      (SETQ x11	    (* (COS imgsang) (* 2.0 arcradval))
	    y11	    (* (SIN imgsang) (* 2.0 arcradval))
	    x12	    (* (COS (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval))
	    y12	    (* (SIN (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval))
	    imgctr  (POLAR arccenpnt
			   (+ imgsang (* 1.25 PI))
			   (/ arcradval (COS (* 0.25 PI)))
		    ) ;_ end of polar
	    assoc10 (CONS 10 imgctr)
	    assoc11 (CONS 11 (LIST x11 y11 0.0))
	    assoc12 (CONS 12 (LIST x12 y12 0.0))
	    imgent  (SUBST assoc10 (ASSOC 10 imgent) imgent)
	    imgent  (SUBST assoc11 (ASSOC 11 imgent) imgent)
	    imgent  (SUBST assoc12 (ASSOC 12 imgent) imgent)
      ) ;_ end of setq
      (ENTMOD imgent)
      (SETQ imgsang 0)
      (imgarcclp imgent imgeang imgorad imgirad cntincr)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN c:imgarc	()
  (IF upoint
    nil
    (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
  ) ;_ end of if
  (IF uangle
    nil
    (LOAD "uangle" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of if
  (IF ureal
    nil
    (LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of if
  (IF ukword
    nil
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (WHILE
    (AND
      (SETQ arcoent (ENTSEL "Select arc or circle (outside edge)"))
      (NOT
	(OR
	  (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "ARC")
	  (EQ (CDR (ASSOC 0 (ENTGET (CAR arcoent)))) "CIRCLE")
	) ;_ end of or
      ) ;_ end of not
    ) ;_ end of and
  ) ;_ end of while
  (SETQ	arccenpnt (CDR (ASSOC 10 (ENTGET (CAR arcoent))))
	arcradval (CDR (ASSOC 40 (ENTGET (CAR arcoent))))
  ) ;_ end of setq
  (PRINC "Arc radius is ")
  (PRINC arcradval)
  (PRINC)
  (IF (NOT (FINDFILE "1x1.bmp"))
    (ALERT
      "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again."
    ) ;_ end of alert
    (PROGN
      (COMMAND ".image" "a" "1x1" arccenpnt 1 0)
      (SETQ imgent (ENTGET (ENTLAST)))
      (SETQ imgoradpt nil)
      (SETQ imgorad arcradval)
      (WHILE (NOT imgoradpt)
	(SETQ imgoradpt (upoint 1 "" "Image start angle" nil arccenpnt))
	(SETQ imgsang (ANGLE (REVERSE (CDR (REVERSE arccenpnt)))
			     (REVERSE (CDR (REVERSE imgoradpt)))
		      ) ;_ end of angle
	) ;_ end of setq
      ) ;_ end of while
      (SETQ imgiradpt nil)
      (WHILE (OR (NOT imgiradpt) (>= imgirad imgorad))
	(SETQ imgiradpt	(upoint
			  1
			  ""
			  "Image inside radius and end angle"
			  nil
			  arccenpnt
			 ) ;_ end of upoint
 ;_ end of upoint
	) ;_ end of setq
	(SETQ imgirad (DISTANCE	(REVERSE (CDR (REVERSE arccenpnt)))
				(REVERSE (CDR (REVERSE imgiradpt)))
		      ) ;_ end of distance
	) ;_ end of setq
      ) ;_ end of while
      (SETQ raweang (ANGLE (REVERSE (CDR (REVERSE arccenpnt)))
			   (REVERSE (CDR (REVERSE imgiradpt)))
		    ) ;_ end of angle
      ) ;_ end of setq
      (IF (< raweang imgsang)
	(SETQ raweang (+ raweang (* 2.0 PI)))
      ) ;_ end of if
      (SETQ imgeang (- raweang imgsang))
      (IF (OR
	    (EQUAL (ABS imgeang) 0 0.00001)
	    (EQUAL (ABS imgeang) (* 2.0 PI) 0.00001)
	  ) ;_ end of or
	(PROGN
	  (SETQ imgeang (* 2.0 PI))
	  (PRINC "\nImage angle set to 360°. ")
	  (PRINC
	    "\n0° is invalid. Key-in near values to achieve proximate results. "
	  ) ;_ end of princ
	) ;_ end of progn
	(PRINC (STRCAT "\nImage angle of "
		       (RTOS (* (/ imgeang (* 2.0 PI)) 360.0) 2 4)
		       "° applied. "
	       ) ;_ end of strcat
	) ;_ end of princ
      ) ;_ end of if
      (SETQ pntcnt (/ (* 2.0 (* 180.0 (/ imgeang PI))) 45.0))
      (SETQ angsure nil)
      (WHILE
	(NOT
	  (AND
	    (SETQ
	      cntincr (ureal 1
			     ""
			     "Angle increment for image clip boundary"
			     pntcnt
		      ) ;_ end of ureal
	    ) ;_ end of setq
	    (IF	(< cntincr pntcnt)
	      (PROGN
		(SETQ angsure
		       (ukword 1
			       "Yes No"
			       (STRCAT "Using and angle increment of "
				       (RTOS cntincr 2 4)
				       " may take awhile.  Are you sure?"
			       ) ;_ end of strcat
			       "No"
		       ) ;_ end of ukword
		) ;_ end of setq
		(IF (EQ angsure "No")
		  nil
		  T
		) ;_ end of if
	      ) ;_ end of progn
	      T
	    ) ;_ end of if
	  ) ;_ end of and
	) ;_ end of not
      ) ;_ end of while
      (PRINC)
      (SETQ x11	    (* (COS imgsang) (* 2.0 arcradval))
	    y11	    (* (SIN imgsang) (* 2.0 arcradval))
	    x12	    (* (COS (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval))
	    y12	    (* (SIN (+ (* 0.5 PI) imgsang)) (* 2.0 arcradval))
	    imgctr  (POLAR arccenpnt
			   (+ imgsang (* 1.25 PI))
			   (/ arcradval (COS (* 0.25 PI)))
		    ) ;_ end of polar
	    assoc10 (CONS 10 imgctr)
	    assoc11 (CONS 11 (LIST x11 y11 0.0))
	    assoc12 (CONS 12 (LIST x12 y12 0.0))
	    imgent  (SUBST assoc10 (ASSOC 10 imgent) imgent)
	    imgent  (SUBST assoc11 (ASSOC 11 imgent) imgent)
	    imgent  (SUBST assoc12 (ASSOC 12 imgent) imgent)
      ) ;_ end of setq
      (ENTMOD imgent)
      (SETQ imgsang 0)
      (imgarcclp imgent imgeang imgorad imgirad cntincr)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN imgarcclp (imgent imgeang imgorad imgirad cntincr /)
  (SETQ imgbase (REVERSE (MEMBER (ASSOC 91 imgent) (REVERSE imgent))))
  (SETQ imgclplst nil)
  (SETQ cpt (LIST 0.0 0.0 0.0))
  (SETQ cnt 0)
  (SETQ interpt (POLAR cpt imgsang 0.5))
  (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
  (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
  (WHILE (< cnt (* 180.0 (/ imgeang PI)))
    (SETQ interpt (POLAR cpt (* (/ cnt 180.0) PI) 0.5))
    (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
    (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
    (SETQ cnt (+ cnt cntincr))
  ) ;_ end of while
  (SETQ interpt (POLAR cpt imgeang 0.5))
  (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
  (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
  (IF (EQ imgirad 0)
    (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 cpt))))
    (PROGN
      (SETQ cnt (- cnt cntincr))
      (SETQ interpt (POLAR cpt imgeang (* (/ imgirad imgorad) 0.5)))
      (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
      (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
      (WHILE (> cnt 0)
	(SETQ interpt (POLAR cpt
			     (* (/ cnt 180.0) PI)
			     (* (/ imgirad imgorad) 0.5)
		      ) ;_ end of polar
	) ;_ end of setq
	(SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
	(SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
	(SETQ cnt (- cnt cntincr))
      ) ;_ end of while
      (SETQ interpt (POLAR cpt 0 (* (/ imgirad imgorad) 0.5)))
      (SETQ imgclpt (LIST (CAR interpt) (* -1 (CADR interpt)) 0.0))
      (SETQ imgclplst (APPEND imgclplst (LIST (CONS 14 imgclpt))))
    ) ;_ end of progn
  ) ;_ end of if
  (SETQ imgclplst (APPEND imgclplst (LIST (CAR imgclplst))))
  (SETQ imgedef (APPEND imgbase imgclplst))
  (SETQ img70 (ASSOC 70 imgedef))
  (IF (EQ (BOOLE 1 (CDR img70) 4) 4)
    nil
    (SETQ imgedef (SUBST (CONS 70 (+ (CDR img70) 4)) img70 imgedef))
  ) ;_ end of if
  (SETQ	imgedef	(SUBST (CONS 71 2)
		       (ASSOC 71 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (SETQ	imgedef	(SUBST (CONS 91 (LENGTH imgclplst))
		       (ASSOC 91 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (SETQ	imgedef	(SUBST (CONS 280 1)
		       (ASSOC 280 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (ENTMOD imgedef)
  (PRINC)
) ;_ end of defun
(DEFUN c:imgpl (/	 found	  plvert_list	    pliness  plinesslen
		sscount	 plent	  plvert   strt40   end41    fpt1
		fpt2	 chrdl	  theta	   psi	    phi	     chang
		arcr	 arcc	  count	   plwinc   plwe     plwb
		incra	 incrn	  initang
	       )
  (SETQ usrdeg 5.0)
  (SETQ pliness (SSGET '((0 . "POLYLINE"))))
  (IF pliness
    (PROGN
      (COMMAND ".undo" "m")
      (SETQ plinesslen
	     (SSLENGTH pliness)
	    sscount 0
      ) ;_ end of setq
      (WHILE (< sscount plinesslen)
	(SETQ currpline (SSNAME pliness sscount))
	(SETQ plent (ENTGET currpline))
	(SETQ plvert (ENTGET (ENTNEXT (CDAR plent))))
	(IF (NOT (FINDFILE "1x1.bmp"))
	  (ALERT
	    "File 1X1.BMP was not found.\nPlease make sure that this file is available and then try again."
	  ) ;_ end of alert
	  (PROGN
	    (COMMAND ".image" "a" "1x1" (CDR (ASSOC 10 plvert)) 1 0)
	    (SETQ imgent (ENTGET (ENTLAST)))
	    (PROGN
	      (SETQ plvert_list
		     (LIST (CONS 14 (CDR (ASSOC 10 plvert))))
	      ) ;_ end of SETQ
;;;----repeat this until the end of the polyline
	      (WHILE
		(/= (CDR (ASSOC 0 (ENTGET (ENTNEXT (CDAR plvert)))))
		    "SEQEND"
		) ;_ end of /=
;;;------if it begins an arc segment
		 (IF (/= (CDR (ASSOC 42 plvert)) 0)
;;;--------do this
		   (PROGN
		     (SETQ found T)
		     (SETQ plnvert (ENTGET (ENTNEXT (CDAR plvert))))
		     (SETQ strt40 (CDR (ASSOC 40 plvert)))
		     (SETQ end41 (CDR (ASSOC 41 plvert)))
		     (SETQ fpt1 (CDR (ASSOC 10 plvert)))
		     (SETQ fpt2 (CDR (ASSOC 10 plnvert)))
		     (SETQ chrdl (DISTANCE fpt1 fpt2))
		     (SETQ theta (ATAN (CDR (ASSOC 42 plvert))))
		     (SETQ psi (- (/ PI 2) (ABS theta)))
		     (SETQ phi (* (ABS theta) 4))
		     (SETQ chang (ANGLE fpt1 fpt2))
		     (SETQ
		       arcr (ABS (/ (* (DISTANCE fpt1 fpt2) (SIN psi))
				    (* 2 (COS theta) (SIN (* 2 theta)))
				 ) ;_ end of /
			    ) ;_ end of abs
		     ) ;_ end of setq
		     (SETQ arcc
			    (IF	(> theta 0)
			      (POLAR fpt1 (+ (- chang theta) psi) arcr)
			      (POLAR fpt1 (- (- chang theta) psi) arcr)
			    ) ;_ end of if
		     ) ;_ end of setq
		     (SETQ		;fenl    (* phi arcr)
		       usrrad (* (/ 5.0 180.0000) PI)
		       count   (1+ (FIX (/ phi usrrad)))
		       plwinc  (/ (- strt40 end41) count)
		       plwe    (+ strt40 plwinc)
		       incra   (/ phi count)
		       incrn   0
		       initang (ANGLE arcc fpt1)
		     ) ;_ end of setq
		     (WHILE
		       (> count 0)
			(SETQ incrn (1+ incrn))
			(SETQ plwb plwe
			      plwe (- plwe plwinc)
			) ;_ end of setq
			(IF (< theta 0)
			  (SETQ	fpt4
				 (POLAR arcc (- initang (* incrn incra)) arcr)
			  ) ;_ end of setq
			  (SETQ	fpt4
				 (POLAR arcc (+ initang (* incrn incra)) arcr)
			  ) ;_ end of setq
			) ;_ end of if
			(SETQ plvert_list
			       (APPEND plvert_list
				       (LIST (CONS 14 fpt4))
			       ) ;_ end of APPEND
			) ;_ end of SETQ
			(SETQ fpt1  fpt4
			      count (1- count)
			) ;_ end of setq
		     ) ;_ end of while
		     (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
		   ) ;_ end of progn
;;;--------or else it begins a line segment so do this
		   (PROGN
		     (SETQ fpt1 (CDR (ASSOC 10 plvert)))
		     (SETQ fpt2
			    (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDAR plvert)))))
		     ) ;_ end of setq
		     (SETQ plvert_list
			    (APPEND plvert_list (LIST (CONS 14 fpt2)))
		     ) ;_ end of SETQ
		     (SETQ fpt1 fpt2)
		     (SETQ plvert (ENTGET (ENTNEXT (CDAR plvert))))
		   ) ;_ end of progn
		 ) ;_ end of if
	      ) ;_ end of while
	    ) ;_ end of progn
	    (SETQ svplvert_list plvert_list)
	    (SETQ sscount (1+ sscount))
	    (IF (AND plvert_list (/=(CAR plvert_list)(CAR (REVERSE plvert_list))))
	      (SETQ plvert_list (APPEND plvert_list (LIST(CAR plvert_List))))
	    )
	    (imgplclp imgent plvert_list)
;;;	    (PRINC "\n")
;;;	    (PRINC (CAR plvert_list))
;;;	    (PRINC "\n")
;;;	    (PRINC (CAR (REVERSE plvert_list)))
;;;	    (PRINC)
	  ) ;_ end of PROGN
	) ;_ end of IF
      ) ;_ end of WHILE
    ) ;_ end of progn
  ) ;_ end of if
  (PRINC)
) ;_ end of defun
(DEFUN imgplclp	(imgent imgclplst / imgminx imgmaxx imgminy imgmaxy imgbase imgedef img70)
  (FOREACH n imgclplst
    (IF	imgminx
      (SETQ imgminx (MIN imgminx (CADR n)))
      (SETQ imgminx (CADR n))
    ) ;_ end of if
    (IF	imgminy
      (SETQ imgminy (MIN imgminy (CADDR n)))
      (SETQ imgminy (CADDR n))
    ) ;_ end of if
    (IF	imgmaxx
      (SETQ imgmaxx (MAX imgmaxx (CADR n)))
      (SETQ imgmaxx (CADR n))
    ) ;_ end of if
    (IF	imgmaxy
      (SETQ imgmaxy (MAX imgmaxy (CADDR n)))
      (SETQ imgmaxy (CADDR n))
    ) ;_ end of if
  ) ;_ end of foreach
  (SETQ	clpctr (POLAR
		 (LIST imgminx imgminy 0)
		 (ANGLE (LIST imgminx imgminy 0) (LIST imgmaxx imgmaxy 0))
		 (/ (DISTANCE (LIST imgminx imgminy 0)
			      (LIST imgmaxx imgmaxy 0)
		    ) ;_ end of distance
		    2.0
		 ) ;_ end of /
	       ) ;_ end of polar
	axmax  (MAX (- imgmaxx imgminx) (- imgmaxy imgminy)); maximum axial dimension of polyline area
        imgctr (POLAR
		 (LIST imgminx imgminy 0)
		 (/ PI 4.0)
		 (* (/ 1.0 (SIN (/ PI 4.0))) (/ axmax 2.0))
	       ) ;_ end of polar
	ptfact 1.0;(/ 0.5 axmax); convert to unit values (axmax = 1.0 but center is at 0,0 and coords range from -0.5 to 0.5)
;;;	imgins (LIST 0.0 0.0 0.0)
	imgins (LIST imgminx imgminy 0)
;;;	imgins (LIST (* -0.5 axmax) (* -0.5 axmax) 0);(LIST (* -100.0 axmax) (* -100.0 axmax) 0);
	imgtr  (LIST imgmaxx imgmaxy 0)
  ) ;_ end of SETQ
;;;  (PRINC "\nimgins=")
;;;  (PRINC imgins)
;;;  (PRINC "\nptfact=")
;;;  (PRINC ptfact)
;;;  (PRINC)
  (FOREACH n imgclplst
;;;  (PRINC "\nn=")
;;;  (PRINC n)
    (SETQ relpt	(POLAR (CDR n)
		  (ANGLE imgctr '(0.0 0.0 0.0))
		  (DISTANCE imgctr '(0.0 0.0 0.0))
		)
    ) ;_ end of SETQ
;;;  (PRINC "\nrelpt=")
;;;  (PRINC relpt)
    (SETQ newpt	(LIST (/ (CAR relpt) axmax)
		      (* -1.0(/ (CADR relpt) axmax))
		      0.0
		) ;_ end of list
    ) ;_ end of SETQ
;;;  (PRINC "\nnewpt 2 =")
;;;  (PRINC newpt)
;;;  (PRINC)
    (SETQ imgclplst (SUBST (CONS 14 newpt) n imgclplst))
  ) ;_ end of FOREACH
  (SETQ	assoc10	(CONS 10 imgins)
	assoc11	(CONS 11 (LIST axmax 0.0 0.0));(CONS 11 (LIST (* 200 axmax) 0.0 0.0));
	assoc12	(CONS 12 (LIST 0.0 axmax 0.0));(CONS 12 (LIST 0.0 (* 200 axmax) 0.0));
	imgent	(SUBST assoc10 (ASSOC 10 imgent) imgent)
	imgent	(SUBST assoc11 (ASSOC 11 imgent) imgent)
	imgent	(SUBST assoc12 (ASSOC 12 imgent) imgent)
  ) ;_ end of setq
;;;  (PRINC "\nASSOC 10 = ")
;;;  (PRINC assoc10)
;;;  (PRINC "\nASSOC 11 = ")
;;;  (PRINC assoc11)
;;;  (PRINC "\nASSOC 12 = ")
;;;  (PRINC assoc12)
;;;  (PRINC)
;;;  (IF
    (ENTMOD imgent)
;;;    NIL
;;;    (PROGN
;;;      (PRINC "\nENTMOD FAILED! (1) ")
;;;      (PRINC "\nimgent=")
;;;      (PRINC imgent)
;;;      (PRINC)
;;;    )
;;;  )
  (IF gvpno
    nil
    (LOAD "gvpno")
  ) ;_ end of if
  (gvpno)
  (IF mjrg
    NIL
    (IF (WCMATCH (STRCASE (SUBSTR (GETVAR "dwgname") 1 1)) "[A C E F G I L M O P Q S T Z]")
      (SETQ mjrg (STRCASE (SUBSTR (GETVAR "dwgname") 1 1)))
      (SETQ mjrg "G")
    ) ;_ end of if
  )
  (SETQ imgbase (REVERSE (MEMBER (ASSOC 91 imgent) (REVERSE imgent))))
  (SETQ imgedef (APPEND imgbase imgclplst))
  (SETQ img70 (ASSOC 70 imgedef))
  (IF (EQ (BOOLE 1 (CDR img70) 4) 4);"Use clipping boundary" bit is on
    nil
    (SETQ imgedef (SUBST (CONS 70 (+ (CDR img70) 4)) img70 imgedef))
  ) ;_ end of if
  (SETQ	imgedef	(SUBST (CONS 71 2);Set clipping boundary "polygonal" bit
		       (ASSOC 71 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (SETQ	imgedef	(SUBST (CONS 91 (LENGTH imgclplst));Number of clip boundary vertices that follow
		       (ASSOC 91 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (SETQ	imgedef	(SUBST (CONS 280 1);Turn clipping state on
		       (ASSOC 280 imgedef)
		       imgedef
		) ;_ end of subst
  ) ;_ end of setq
  (IF (AND mjrg prod)
    (SETQ imgedef (SUBST (CONS 8 (STRCAT mjrg "-" prod "7AREA-HIDE"));Set layer name
                         (ASSOC 8 imgedef)
                         imgedef
                  ) ;_ end of subst
    ) ;_ end of setq
  )
;;;  (IF
    (ENTMOD imgedef)
;;;    NIL
;;;    (PROGN
;;;      (PRINC "\nENTMOD FAILED! (2) ")
;;;      (PRINC "\nimgent=")
;;;      (PRINC imgent)
;;;      (PRINC)
;;;    )
;;;  )
  (PRINC)
) ;_ end of defun
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;