;;--------------------=={ CurveText.lsp }==-------------------;;
;;                                                            ;;
;;  Positions Text along a curve object (arc, circle, spline, ;;
;;  ellipse, line, lwpolyline, polyline), and rotates text    ;;
;;  to fit to the curve accordingly.                          ;;
;;                                                            ;;
;;  If run in versions > AutoCAD2000, the resultant text will ;;
;;  form an anonymous group.                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version:  1.4    -    22-02-2012                          ;;
;;------------------------------------------------------------;;

(defun c:lm_CurveText ( / LM:CurveText LM:isAnnotative LM:SelectionOrText sel str obj wid1 wid2 old_selectioncycling )
	(mai_last_com "lm_CurveText")

(defun LM:isAnnotative ( style / obj xdt )
	(and
		(setq obj (tblobjname "STYLE" style))
		(setq xdt (cadr (assoc -3 (entget obj '("AcadAnnotative")))))
		(= 1 (cdr (assoc 1070 (reverse xdt))))
	)
)

(defun LM:SelectionOrText ( msg pred / en g1 g2 gr result )
	(setq pred (eval pred))

	(if msg
		(princ msg)
		(princ (setq msg "\n选择文字实体或输入文字:"))
	)
	(setq result "")

	(while
		(progn
			(setq gr (grread t 13 2)
				  g1 (car  gr)
				  g2 (cadr gr)
			)
			(cond
				(	(= 03 g1)
					(if (setq en (car (nentselp g2)))
						(if (pred en)
							(not (setq result en))
							(princ (strcat "\n选择错的实体." msg))
						)
						(princ (strcat "\n空选，再选一次." msg))
					)
				)
				(   (= 02 g1)
					(cond
						(	(< 31 g2 127) (setq result (strcat result (princ (chr g2)))))
						(	(= 13 g2) nil)
						(	(= 08 g2)
							(if (< 0 (strlen result))
								(progn
									(setq result (substr result 1 (1- (strlen result))))
									(princ (vl-list->string '(8 32 8)))
								)
							)
							t
						)
						(	t	)
					)
				)
				(	(= 25 g1) nil)
				(	t	)
			)
		)
	)
	result
)





(defun LM:CurveText ( str ent / old_cmd 3pi/2 a1 a2 a3 acdoc acspc df di dr g1 g2 gr in ln lst ms obj p1 p2 p3 pi/2 ts ob_mark
								max_space ent_length ent_close wid1 wid2 llst tm1 tm2 tent rev 
					)

	(mini_start T)
	(setq acdoc (vlax-get-property (vlax-get-acad-object) 'activedocument)
		  acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
		  ob_mark (entlast)
	)
	(or *offset* (setq *offset* 0.0))
	(or *spacin* (setq *spacin* 1.1))

	(setq
		sel (if sel (vlax-ename->vla-object sel))
		ts
		 (/ (if sel (vlax-get-property sel 'Height) (getvar 'textsize))
			(if (LM:isAnnotative (getvar 'textstyle))
				(cond ((getvar 'cannoscalevalue)) ( 1.0 ))
				1.0
			)
		 )
		ms (if sel (vlax-get-property sel 'StyleName) (getvar 'textstyle))
		lst (mapcar
				'(lambda ( c )
					(setq obj (vla-addtext acspc c (vlax-3D-point (getvar 'VIEWCTR)) ts))
					(vlax-put-property obj 'alignment acalignmentmiddlecenter)
					(vlax-put-property obj 'StyleName ms)
					obj
				)
				(mai_str2lst str "")
			)
		wid1 (textbox (entget (vlax-vla-object->ename (car lst))))
		wid1 (* 0.5 (- (caadr wid1) (caar wid1)))
		wid2 (textbox (entget (vlax-vla-object->ename (last lst))))
		wid2 (* 0.5 (- (caadr wid2) (caar wid2)))
		ms    (princ "\n[W/S]键调整偏移值, [A/D]键调整间距，文字位置:")
		ln    (length lst)
		pi/2  (* 0.5 pi)
		3pi/2 (* 1.5 pi)
		ent_close (mai_curve_isclosed ent)
		ent_length (mai_curve_length ent)
		max_space
			(if ent_close
				(/ ent_length ln)
				(/ (- ent_length wid1 wid2) (1- ln))
			)
		max_space (/ max_space ts)
	)
	(while
		(progn
			(setq
				gr (grread t 15 0)
				g1 (car  gr)
				g2 (cadr gr)
			)
			(cond
				(	(or (= 05 g1) (= 03 g1))
					(setq
						p1 (trans g2 1 0)
						p2 (vlax-curve-getclosestpointto ent p1)
						dr (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p2)))
						di (vlax-curve-getdistatpoint ent p2)
						p1 (mai_point_per2line p1 p2 (polar p2 (+ dr pi/2) 5.))
						a1 (angle p2 p1)
						df (- a1 dr)
						in -1
						a2 (cond
								((and (> dr pi/2) (<= dr pi)) (- pi))
								((and (> dr pi) (<= dr 3pi/2)) pi)
								(0.0)
						 )
						rev (and (< pi/2 dr) (<= dr 3pi/2))
						di (if ent_close di (max di (if rev wid2 wid1)))
						di (if ent_close di (min di (- ent_length (if rev wid1 wid2) (* (1- ln) *spacin* ts))))
					)
					(foreach obj (if rev (reverse lst) lst)
						(if (setq
								in (1+ in)
								p3 (vlax-curve-getPointatDist ent (rem (+ di (* in *spacin* ts)) ent_length))
							)
							(progn
								(setq
									a3 (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p3)))
									tent (vlax-vla-object->ename obj)
									llst (entget tent)
									llst (subst (cons 50 (+ a2 a3)) (assoc 50 llst) llst)
								)
								(entmod llst)
								(setq
									llst (entget tent)
									tm1 (mapcar '- (mai_dxf 11 llst)(mai_dxf 10 llst))
									tm2 (polar p3 (+ a3 df) (* ts *offset*))
									llst (subst (cons 11 tm2) (assoc 11 llst) llst)
									llst (subst (cons 10 (mapcar '- tm2 tm1)) (assoc 10 llst) llst)
								)
								(entmod llst)
								;~ (vla-put-TextAlignmentPoint obj (vlax-3D-point (polar p3 (+ a3 df) (* ts *offset*))))
								;~ (vlax-put-property obj 'INSERTIONPOINT (setq nnn (polar p3 (+ a3 df) (* ts *offset*))))
								;~ (vlax-put-property obj 'rotation (+ a2 a3))
							)
						)
					)
					(= 05 g1)
				)
				(	(= 25 g1) nil)
				(	(= 02 g1)
					(cond
						((member g2 '(13 32)) nil)
						((member g2 '(119 87)) (setq *offset* (+ *offset* 0.1))) ;w
						((member g2 '(83 115)) (setq *offset* (- *offset* 0.1))) ;s
						((member g2 '(100 68)) (setq *spacin* (min max_space (+ *spacin* 0.05)))) ;d
						((member g2 '(97 65)) (setq *spacin* (max 0.05 (- *spacin* 0.05)))) ;a
						((princ (strcat "\n不支持此键." ms)))
					)
				)
				(	t	)
			)
		)
	)
	(mai_group_creat (mai_newset ob_mark))
	(mai_end)
)
;~ (progn
;~ (setq a(car(entsel)))
;~ (setq b (entget a))
;~ (setq b (subst (cons 10 (getpoint)) (assoc 10 b) b))
;~ (entmod b)
;~ )



	(cond
		(	(= 4 (logand 4 (mai_dxf 70 (tblsearch "LAYER" (getvar 'CLAYER)))))
			(princ "\n当前层被锁定.")
		)
		(	(and
				(setq sel (LM:SelectionOrText "\n选择或输入按曲线排的文字:" '(lambda(x)(wcmatch (mai_dxf 0 x) "*TEXT,ATTRIB"))))
				(or (and
						(eq 'STR (type sel))
						(setq obj sel sel nil str obj)
					)
					(setq str (mai_clear_mtformat (mai_dxf 1 sel)))
				)
				(progn (if sel (redraw sel 3)) T)
				(setq obj (car (mai_entsel nil "选择按曲线排字的曲线:<回车退出>" "选择的不是多义线、线、圆或弧." '((0 . "*Polyline,line,arc,circle,spline,ellipse")) nil)))
				(progn (if sel (redraw sel 4)) T)
			)
			(setq old_selectioncycling (getvar "selectioncycling"))
			(if old_selectioncycling (setvar "selectioncycling" 0))
			(LM:CurveText str obj)
		)
	)
	(princ)
)
