;;----------------------=={ Align Text to Curve }==---------------------;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  Program Overview                                                    ;;
;;  -----------------------------------                                 ;;
;;  This program enables the user to dynamically align a new or         ;;
;;  existing Text or MText object to a selected curve, with intuitive   ;;
;;  placement controls available.                                       ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  User Input                                                          ;;
;;  -----------------------------------                                 ;;
;;  Upon issuing the command syntax 'atc' at the AutoCAD command-line,  ;;
;;  the user is prompted to select a Text or MText object to align.     ;;
;;  At this prompt, the user also has the option to create a new Text   ;;
;;  or MText object, or configure the program settings.                 ;;
;;                                                                      ;;
;;  If the 'New' option is chosen, the user is prompted to enter the    ;;
;;  content for the new text object, or may press 'Enter' to return to  ;;
;;  the previous prompt.                                                ;;
;;                                                                      ;;
;;  If the 'Settings' option is chosen, the user is presented with a    ;;
;;  dialog interface through which several program parameters may be    ;;
;;  configured - these settings are detailed in the section below.      ;;
;;                                                                      ;;
;;  The user is then prompted to select a curve to which the text will  ;;
;;  be dynamically aligned. The program is compatible for use with      ;;
;;  Lines, LWPolylines, 2D (Heavy) Polylines, 3D Polylines, Arcs,       ;;
;;  Circles, Ellipses, Elliptical Arcs & Splines; furthermore, these    ;;
;;  objects may be primary or nested (to any depth) within a block or   ;;
;;  xref.                                                               ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  Dynamic Text Alignment                                              ;;
;;  -----------------------------------                                 ;;
;;  Following valid selection of a curve, the new or existing Text or   ;;
;;  MText object is dynamically aligned to the curve based on the       ;;
;;  position of the AutoCAD cursor.                                     ;;
;;                                                                      ;;
;;  During text alignment, several controls are available at the        ;;
;;  command-line to refine the text position & other properties; these  ;;
;;  controls are individually detailed below:                           ;;
;;                                                                      ;;
;;  [ Enter ]  -  (or Esc/Space/Right-Click) Exit program (Cancel)      ;;
;;  [ Click ]  -  Place text                                            ;;
;;  [  +/-  ]  -  Incrementally increase/decrease text offset           ;;
;;  [   O   ]  -  Specify exact text offset                             ;;
;;  [  </>  ]  -  Rotate text by 45 degrees                             ;;
;;  [   R   ]  -  Specify exact text rotation (relative to curve)       ;;
;;  [   Y   ]  -  Toggle text readability                               ;;
;;  [   B   ]  -  Toggle MText Background Mask                          ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  Program Settings                                                    ;;
;;  -----------------------------------                                 ;;
;;  Upon selecting the 'Settings' option when prompted, the user is     ;;
;;  presented with a dialog interface offering the following options:   ;;
;;                                                                      ;;
;;  Object type for new text: this setting determines whether the       ;;
;;  program will create a single-line Text object or MText object when  ;;
;;  the user opts to create a new text.                                 ;;
;;                                                                      ;;
;;  Justification for new text: this setting controls the justification ;;
;;  of any new text object created by the program.                      ;;
;;                                                                      ;;
;;  Text Offset Factor: this is the default offset factor of the text   ;;
;;  from the selected curve, as a multiple of the text height. This     ;;
;;  factor may also be zero if the text is to be positioned directly    ;;
;;  over the selected curve.                                            ;;
;;                                                                      ;;
;;  Text Rotation: this setting controls the default rotation of the    ;;
;;  text relative to the selected curve.                                ;;
;;                                                                      ;;
;;  Text Readability: this toggle determines whether the text should    ;;
;;  be rotated to preserve readability, i.e. the text will never appear ;;
;;  upside-down.                                                        ;;
;;                                                                      ;;
;;  Background Mask: this toggle controls whether a background mask is  ;;
;;  used when aligning MText objects.                                   ;;
;;                                                                      ;;
;;  Multiple Text Mode: if this setting is enabled, the program will    ;;
;;  continuously generate text objects to align with the selected curve ;;
;;  until the user exits the program.                                   ;;
;;                                                                      ;;
;;  -----------------------------------                                 ;;
;;  Notes                                                               ;;
;;  -----------------------------------                                 ;;
;;  The program is compatible with all full versions of AutoCAD         ;;
;;  supporting Visual LISP with ActiveX (COM) functionality (that is,   ;;
;;  AutoCAD 2000 onwards on a Windows OS).                              ;;
;;                                                                      ;;
;;  The program will perform successfully under all UCS & View          ;;
;;  settings and with Annotative Text Styles.                           ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright ?2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    12-10-2013                                      ;;
;;                                                                      ;;
;;  First release - previously 'CurveAlignedTextV1-1.lsp'.              ;;
;;----------------------------------------------------------------------;;

(setq atc:version "1.2")

;;----------------------------------------------------------------------;;

(defun c:lm_atc ( /
		*error*
		ang
		bak
		cfg
		dcl def dis
		ent enx
		gr1 gr2
		hgt
		jus
		mat msg mtp
		nrm
		off
		pi2 prn prp pt1 pt2 pt3
		red rot
		sav sel str sym
		tmp txt typ
		uxa
	)
	(mai_last_com "lm_atc")

	(defun *error* ( msg / x )
		(and
			(= 'list (type def))
			(= 'str  (type cfg))
			(findfile cfg)
			(atc:writeconfig cfg (mapcar 'eval (mapcar 'car def)))
		)
		(and
			(= 'vla-object (type txt))
			(not (vlax-erased-p txt))
			(vlax-write-enabled-p txt)
			(if (= 'list (type prp))
				(foreach x prp
					(if (vlax-property-available-p txt (car x) t)
						(vl-catch-all-apply 'vlax-put-property (cons txt x))
					)
				)
				(vl-catch-all-apply 'vla-delete (list txt))
			)
		)
		(and
			(= 'list  (type mat))
			(= 'ename (type ent))
			(entget ent)
			(entdel ent)
		)
		(atc:endundo (atc:acdoc))
		(and msg 
			(not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(princ (strcat "\nError: " msg))
		)
		(princ)
	)

	(atc:startundo (atc:acdoc))
	(cond
		(	(or (atc:layerlocked (getvar 'clayer))
				(atc:layerlocked "0")
			)
			(princ "\n当前层或0层被锁定.")
		)
		(	(null (vl-file-directory-p (setq sav (strcat mai_mini_path "用户设置"))))
			(princ "\n保存路径不存在.")
		)
		(	(progn
				(setq def
					'(
						(typ . "txt")
						(jus . "Middle-Center")
						(off . 1.0)
						(rot . 0.0)
						(red . t)
						(bak . nil)
						(mtp . nil)
					)
				)
				(setq
					cfg (strcat sav "\\LMAC_ATC_V" (vl-string-translate "." "-" atc:version) ".cfg")
					dcl (strcat sav "\\LMAC_ATC_V" (vl-string-translate "." "-" atc:version) ".dcl")
				)
				(or (findfile cfg)
					(atc:writeconfig cfg (mapcar 'cdr def))
				)
				(atc:readconfig cfg (setq sym (mapcar 'car def)))

				(while
					(progn
						(setvar 'errno 0)
						(initget "New Settings Exit")
						(setq sel (entsel "\n[新建(New)/设置(Settings)]单选选择要对齐的文字:<退出Exit>"))
						(cond
							(	(= 7 (getvar 'errno))
								(princ "\n空选，再试一次.")
							)
							(	(= 'list (type sel))
								(setq ent (car sel) enx (entget ent))
								(cond
									(	(not (wcmatch (mai_dxf 0 enx) "TEXT,MTEXT"))
										(princ "\n选择的必须是文字TEXT或多行文字MTEXT.")
									)
									(	(atc:layerlocked (mai_dxf 8 enx))
										(princ "\n选择的文字在被锁定的图层上.")
									)
									(	t
										(setq
											txt (vlax-ename->vla-object ent)
											prp (atc:getproperties txt)
										)
										nil
									)
								)
							)
							(	(= "Exit" sel) nil)
							(	(= "Settings" sel) (mapcar 'set sym (atc:settings dcl (mapcar 'eval sym))))
							(	(= "New" sel) (= "" (vl-string-trim " \t\n" (setq str (getstring t "\n输入文字:<选择Select>")))))
						)
					)
				)
				(not
					(or (= 'vla-object (type txt))
						(and (= 'str (type str)) (/= "" (vl-string-trim " \t\n" str)))
					)
				)
			)
			(atc:writeconfig cfg (mapcar 'eval sym))
		)
		(	(progn
				(while
					(progn
						(setvar 'errno 0)
						(setq sel (nentselp "\n选择要对齐文字的曲线:<Exit>"))
						(cond
							(	(= 7 (getvar 'errno))
								(princ "\n没选到, 再试一次.")
							)
							(	(= 'ename (type (car sel)))
								(if
									(or (= "VERTEX" (mai_dxf 0 (car sel)))
										(vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list (car sel))))
									)
									(princ "\n选择错实体.")
								)
							)
						)
					)
				)
				(null sel)
			)
		)
		(	(not
				(or ;(not (princ "\naaa"))(not (princ sel))
					(and
						(setq mat (caddr sel))
						(setq ent (atc:copynested (car sel) mat))
					)
					(and
						(setq gr1 (entget (car sel)))
						(= "VERTEX" (mai_dxf 0 gr1))
						(setq ent (mai_dxf 330 gr1))
					)
					(setq ent (car sel))
				)
			)
			(princ "\n不能重生成嵌套实体.")
		)
		(	t
			(if (null txt)
				(if (= "txt" typ)
					(progn
						(setq txt
								(vla-addtext
									(vlax-get-property (atc:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
									str
									(vlax-3D-point (trans (cadr sel) 1 0))
									(atc:styleheight (getvar 'textstyle))
								)
						)
						(vlax-put-property
							txt
							'alignment
							(eval
								(cadr
									(assoc jus
										'(
											("Left"          acalignmentleft)
											("Center"        acalignmentcenter)
											("Right"         acalignmentright)
											("Middle"        acalignmentmiddle)
											("Top-Left"      acalignmenttopleft)
											("Top-Center"    acalignmenttopcenter)
											("Top-Right"     acalignmenttopright)
											("Middle-Left"   acalignmentmiddleleft)
											("Middle-Center" acalignmentmiddlecenter)
											("Middle-Right"  acalignmentmiddleright)
											("Bottom-Left"   acalignmentbottomleft)
											("Bottom-Center" acalignmentbottomcenter)
											("Bottom-Right"  acalignmentbottomright)
										)
									)
								)
							)
						)
					)
					(progn
						(setq txt
								(vla-addmtext
									(vlax-get-property (atc:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
									(vlax-3D-point (trans (cadr sel) 1 0))
									(	(lambda ( box ) (- (caadr box) (caar box)))
										(textbox
											(list
												(cons 01 (strcat str "."))
												(cons 40 (atc:styleheight (getvar 'textstyle)))
												(cons 07 (getvar 'textstyle))
											)
										)
									)
									str
								)
						)
						(vlax-put-property
							txt
							'attachmentpoint
							(eval
								(cadr
									(assoc jus
										'(
											("Top-Left"      acattachmentpointtopleft)
											("Top-Center"    acattachmentpointtopcenter)
											("Top-Right"     acattachmentpointtopright)
											("Middle-Left"   acattachmentpointmiddleleft)
											("Middle-Center" acattachmentpointmiddlecenter)
											("Middle-Right"  acattachmentpointmiddleright)
											("Bottom-Left"   acattachmentpointbottomleft)
											("Bottom-Center" acattachmentpointbottomcenter)
											("Bottom-Right"  acattachmentpointbottomright)
										)
									)
								)
							)
						)
						(vlax-put txt 'height (atc:styleheight (getvar 'textstyle)))
						(if bak (vlax-put-property txt 'backgroundfill :vlax-true))
					)
				)
			)
			; (if (and
					; (= "AcDbText" (vlax-get-property txt 'objectname))
					; (/= acalignmentleft (vlax-get-property txt 'alignment))
				; )
				; (setq prn 'textalignmentpoint)
				; (setq prn 'insertionpoint)
			; )
			(setq oldalignment (vlax-get txt 'alignment))
			(vlax-put-property txt 'alignment 4) ;或10
			(setq
				hgt (vlax-get txt 'height)
				pi2 (/ pi -2.0)
				nrm (trans '(0.0 0.0 1.0) 1 0 t)
				uxa (if (= "AcDbText" (vlax-get txt 'objectname)) (angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 nrm t)) 0.0)
				msg (strcat
						"\n按[W增加/S减少/O输入]偏移距离 | 按[A减少/D增加/R输入]调整角度 | [修正旋转角度y]:<退出E>"
						(if (= "AcDbMText" (vlax-get txt 'objectname))
							" [B]背景遮罩 | <退出>: "
							" <E退出>: "
						)
					)
			)
			(princ msg)
			(while
				(progn
					(setq
						gr1 (grread t 15 0)
						gr2 (cadr gr1)
						gr1 (car  gr1)
					)
					(cond
						(	(or (= 5 gr1) (= 3 gr1))
							(setq
								pt2 (trans gr2 1 0)
								pt1 (mai_curve_getderiv ent pt2)
								pt1 (mai_point_per2line pt2 (car pt1) (cadr pt1))
							)
							(or (mai_equal pt1 pt2)
								(progn
									(setq
										dis (/ (* hgt off) (distance pt1 pt2))
										ang (+ (angle (trans pt1 0 1) gr2) uxa rot pi2)
									)
									; (vlax-put-property txt prn (vlax-3D-point (mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt1 pt2)))
									; (vlax-put txt prn (mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt1 pt2 ))
									(vlax-put txt 'textalignmentpoint (mapcar '(lambda ( a b ) (+ a (* (- b a) dis))) pt1 pt2 ))
									(vlax-put txt 'rotation (if red (atc:readable ang) ang))
								)
							)
							(cond
								(	(= 5 gr1))
								(	mtp
									(setq
										txt (vla-copy txt)
										prp nil
									)
									t
								)
							)
						)
						(   (= 2 gr1)
							(cond
								(	(member gr2 '(119 87)) (setq off (+ off 0.1)))
								(	(member gr2 '(83 115)) (setq off (- off 0.1)))
								(	(member gr2 '(100 68)) (setq rot (+ rot (/ pi 4.0))))
								(	(member gr2 '(97 65)) (setq rot (- rot (/ pi 4.0))))
								(	(member gr2 '(013 032 069 101))
									(*error* nil)
									nil
								)
								(	(member gr2 '(089 121))
									(if (setq red (not red))
										(princ "\n<修正旋转角度开启>")
										(princ "\n<修正旋转角度关闭>")
									)
									(princ msg)
								)
								(	(member gr2 '(66 098))
									(if (= "AcDbMText" (vlax-get txt 'objectname))
										(progn
											(vlax-put txt 'backgroundfill (~ (vlax-get txt 'backgroundfill)))
											(if (setq bak (eq :vlax-true (vlax-get-property txt 'backgroundfill)))
												(princ "\n<背景开>")
												(princ "\n<背景关>")
											)
										)
										(princ "\n背景仅支持多重文字Mtext实体.")
									)
									(princ msg)
								)
								(	(member gr2 '(82 114))
									(if (setq tmp (getangle (strcat "\n旋转角度: <" (angtos rot) ">")))
										(setq rot tmp)
									)
									(princ msg)
								)
								(	(member gr2 '(79 111))
									(if (setq tmp (getdist (strcat "\n偏移距离: <" (rtos (* hgt off)) ">")))
										(setq off (/ tmp hgt))
									)
									(princ msg)
								)
								(	t	)
							)
						)
						(	(member gr1 '(11 25))
							(*error* nil)
							nil
						)
						(	t	)
					)
				)
			)
			(and
				txt
				(not (member oldalignment (list 3 5)))
				(setq pt1 (vlax-vla-object->ename txt))
				(entget pt1)
				(progn
					(setq pt2 (caddr (mai_getboundingbox pt1)))
					(vlax-put txt 'Alignment oldalignment)
					(command "_.move" pt1 "" "non" (caddr (mai_getboundingbox pt1)) "non" pt2)
				)
			)
			(if mat (entdel ent))
			(atc:writeconfig cfg (mapcar 'eval sym))
		)
	)
	(atc:endundo (atc:acdoc))
	(princ)
)

;;----------------------------------------------------------------------;;

(defun atc:readable ( a )
	(	(lambda ( a )
			(if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
				(atc:readable (+ a pi))
				a
			)
		)
		(rem (+ a pi pi) (+ pi pi))
	)
)

;;----------------------------------------------------------------------;;

(defun atc:styleheight ( sty / tmp )
	(if (zerop (setq tmp (mai_dxf 40 (tblsearch "style" sty))))
		(setq tmp (getvar 'textsize))
	)
	(if (atc:annotative-p sty)
		(/ tmp (cond ((getvar 'cannoscalevalue)) (1.0)))
		tmp
	)
)

;;----------------------------------------------------------------------;;

(defun atc:annotative-p ( sty )
	(and
		(setq sty (tblobjname "style" sty))
		(setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
		(= 1 (mai_dxf 1070 (reverse sty)))
	)
)

;;----------------------------------------------------------------------;;

(defun atc:copynested ( ent mat / enx tmp )
	(if (= 1 (mai_dxf 66 (setq enx (entget ent))))
		(progn
			(atc:entmakex enx)
			(setq ent (entnext ent)
				  enx (entget  ent)
			)
			(while (/= "SEQEND" (mai_dxf 0 enx))
				(atc:entmakex enx)
				(setq ent (entnext ent)
					  enx (entget  ent)
				)
			)
			(setq tmp (cdr (assoc 330 (entget (atc:entmakex enx)))))
		)
		(setq tmp (atc:entmakex enx))
	)
	(if tmp (vla-transformby (vlax-ename->vla-object tmp) (vlax-tmatrix mat)))
	tmp
)

;;----------------------------------------------------------------------;;

(defun atc:entmakex ( enx )
	(entmakex
		(append
			(vl-remove-if
				(function
					(lambda ( x )
						(or (member (car x) '(005 006 008 039 048 062 102 370))
							(= 'ename (type (cdr x)))
						)
					)
				)
				enx
			)
		   '(
				(006 . "CONTINUOUS")
				(008 . "0")
				(039 . 0.0)
				(048 . 1.0)
				(062 . 7)
				(370 . 0)
			)
		)
	)
)

;;----------------------------------------------------------------------;;

(defun atc:getproperties ( obj )
	(vl-remove nil
		(mapcar
			(function
				(lambda ( prp )
					(if (vlax-property-available-p obj prp t)
						(list prp (vlax-get-property obj prp))
					)
				)
			)
			'(
				insertionpoint
				textalignmentpoint
				backgroundfill
				rotation
			)
		)
	)
)

;;----------------------------------------------------------------------;;

(defun atc:settings ( dcl lst / *error* key alg bak dch jus mtp off off:str red rot rot:str typ typ:fun )

	(defun *error* ( msg )
		(if (< 0 dch)
			(unload_dialog dch)
		)
		(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
			(princ (strcat "\nError: " msg))
		)
		(princ)
	)
	
	(cond
		(	(not (atc:writedcl dcl))
			(princ "\nDCL file could not be written.")
		)
		(	(<= (setq dch (load_dialog dcl)) 0)
			(princ "\nDCL file could not be loaded.")
		)
		(	(not (new_dialog "atc" dch))
			(princ "\nProgram dialog could not be loaded.")
		)
		(	t
			(mapcar 'set '(typ jus off rot red bak mtp) lst)
			(set_tile typ "1")
			(
				(setq typ:fun
					(lambda ( typ )
						(setq alg (atc:justlist typ))
						(set_tile "jus"
							(itoa
								(cond
									((vl-position jus alg))
									((setq jus (car alg)) 0)
								)
							)
						)
						(mode_tile "bak" (if (= "mtx" typ) 0 1))
					)
				)
				typ
			)
			(action_tile "jus" "(setq jus (nth (atoi $value) alg))")
			(action_tile "txt" "(typ:fun (setq typ $key))")
			(action_tile "mtx" "(typ:fun (setq typ $key))")

			(set_tile    "off"  (setq off:str (rtos off)))
			(action_tile "off" "(setq off:str $value)")

			(set_tile    "rot"  (setq rot:str (angtos rot)))
			(action_tile "rot" "(setq rot:str $value)")

			(foreach key '("red" "bak" "mtp")
				(set_tile    key (if (eval (read key)) "1" "0"))
				(action_tile key (strcat "(setq " key " (= \"1\" $value))"))
			)
			(action_tile "accept"
				(vl-prin1-to-string
					'(cond
						(	(not (distof off:str))
							(alert "\nOffset Factor must be numerical.")
							(mode_tile "off" 2)
						)
						(	(not (angtof rot:str))
							(alert "\nText Rotation must be numerical.")
							(mode_tile "rot" 2)
						)
						(	(setq off (distof off:str)
								  rot (angtof rot:str)
							)
							(done_dialog 1)
						)
					)
				)
			)
		 
			(if (= 1 (start_dialog))
				(setq lst (list typ jus off rot red bak mtp))
			)
		)
	)
	(if (< 0 dch)
		(unload_dialog dch)
	)
	lst
)

;;----------------------------------------------------------------------;;

(defun atc:justlist ( typ / lst itm )
	(start_list "jus")
	(foreach itm
		(setq lst
			(append
				(if (= "txt" typ)
					'(
						"Left"
						"Center"
						"Right"
						"Middle"
					)
				)
				'(
					"Top-Left"
					"Top-Center"
					"Top-Right"
					"Middle-Left"
					"Middle-Center"
					"Middle-Right"
					"Bottom-Left"
					"Bottom-Center"
					"Bottom-Right"
				)
			)
		)
		(add_list itm)
	)
	(end_list)
	lst
)

;;----------------------------------------------------------------------;;

(defun atc:layerlocked ( lay / def )
	(and
		(setq def (tblsearch "layer" lay))
		(= 4 (logand 4 (mai_dxf 70 def)))
	)
)

;;----------------------------------------------------------------------;;

(defun atc:writedcl ( dcl / des )
	(cond
		((findfile dcl))
		((mai_write_file
			   dcl
			   '(   "edt : edit_box"
					"{edit_width = 8;edit_limit = 10;alignment = left;}"
					"atc : dialog"
					"{label = \"设置\";spacer;"
					"    : text{label = \"新生成文字类型:\";}"
					"    : radio_row"
					"    {alignment = centered;fixed_width = true;"
					"        : radio_button{key = \"txt\";label = \"单行文字\";}"
					"        : radio_button{key = \"mtx\";label = \"多重文字\";}"
					"    }"
					"    spacer;"
					"    : text{label = \"文字对齐基点:\";}"
					"    : popup_list{key = \"jus\";}"
					"    spacer;"
					"    : edt{key = \"off\";label = \"偏移系数:\";}"
					"    : edt{key = \"rot\";label = \"旋转角度:\";}"
					"    spacer;"
					"    : toggle{key = \"red\";label = \"修正旋转角度\";}"
					"    : toggle{key = \"bak\";label = \"多重文字背景遮罩\";}"
					"    : toggle{key = \"mtp\";label = \"多重文字样式\";}"
					"    spacer;ok_cancel;}"
				)
			)
		)
	)
)

;;----------------------------------------------------------------------;;

(defun atc:writeconfig ( cfg lst / _tostring des x )
 
	(defun _tostring ( x / dim )
		(cond
			(	(= 'int (type x))
				(itoa x)
			)
			(	(= 'real (type x))
				(setq dim (getvar 'dimzin))
				(setvar 'dimzin 0)
				(setq x (rtos x 2 8))
				(setvar 'dimzin dim)
				x
			)
			(	(vl-prin1-to-string x))
		)
	)
	
	(if (setq des (open cfg "w"))
		(progn
			(foreach x lst (write-line (_tostring x) des))
			(setq des (close des))
			t
		)
	)
)

;;----------------------------------------------------------------------;;

(defun atc:readconfig ( cfg lst / des itm sym )
	(and
		(setq cfg (findfile cfg))
		(setq des (open cfg "r"))
		(progn
			(foreach sym lst
				(if (setq itm (read-line des))
					(set  sym (read itm))
				)
			)
			(setq des (close des))
			t
		)
	)
)


;;----------------------------------------------------------------------;;

(defun atc:startundo ( doc )
	(atc:endundo doc)
	(vla-startundomark doc)
)

;;----------------------------------------------------------------------;;

(defun atc:endundo ( doc )
	(while (= 8 (logand 8 (getvar 'undoctl)))
		(vla-endundomark doc)
	)
)

;;----------------------------------------------------------------------;;

(defun atc:acdoc nil
	(eval (list 'defun 'atc:acdoc 'nil (vlax-get (vlax-get-acad-object) 'activedocument)))
	(atc:acdoc)
)

;;----------------------------------------------------------------------;;

(princ)

