;;;========================================================
;;;      练习                                              
;;;功能：通用grread研究                                    
;;=================================================
;;  通用grread定义
(defun ZML-GRREAD (LST / TEST TMP MODE VAL TMP2)
    (setq TEST t)
    (while TEST
	(setq TMP  (grread 2)
	      MODE (car TMP)
	      VAL  (cadr TMP)
	)
	(cond ((= MODE 2)
	       (if (and	(setq TMP2 (assoc MODE LST))
			(setq TMP2 (cdr TMP2))
			(setq TMP2 (assoc VAL TMP2))
		   )
		   (eval (cons 'progn (cdr TMP2)))
		   ()
	       )
	      )
	      ((setq TMP2 (assoc MODE LST))
	       (eval (cons 'progn (cdr TMP2)))
	      )
	      (t (princ TMP))
	)
    )
)
;;;========================================================
;;;文字随线(角度随线的)
(vl-load-com)
(defun C:TT (/ tt-01 tt-02 LST)
    ;;===============
    ;;功能：计算计算距给定点位最近的线上点 和 线上点的前进方位角
    ;;参数：EN_LINE -----线的图元名称
    ;;           PT -----给定点位
    ;;返回：距点最近的线上点 和 线上点的方位角
    (defun TT-01 (EN_LINE PT / OBJ PT1 LST ANG)
	;;将图元名转换为 VLA对象
	(setq OBJ (vlax-ename->vla-object EN_LINE))
	;;距pt最近的曲线上的点pt1
	(setq PT1 (vlax-curve-getclosestpointto OBJ PT))
	;;pt1点的切线方向矢量
	(setq LST (vlax-curve-getfirstderiv
		      OBJ
		      (vlax-curve-getparamatpoint
			  OBJ
			  PT1
		      )
		  )
	)
	;;计算切线方位角
	(setq ANG (atan (/ (cadr LST) (car LST))))
	;;返回
	(list PT1 ANG)
    )
    ;;===============
    ;;功能：设置文字对象位置及角度
    (defun TT-02 (EN_TEXT PT ANG / ENT)
	(setq ENT (entget EN_TEXT))
	(setq ENT (subst (cons 10 PT) (assoc 10 ENT) ENT)
	      ENT (subst (cons 11 PT) (assoc 11 ENT) ENT)
	      ENT (subst (cons 50 ANG) (assoc 50 ENT) ENT)
	)
	(entmod ENT)

    )
    ;;===============
    (if	(and
	    ;;
	    (setq SS (entsel "\n点取线: "))
	    (setq EN_LINE (car SS))
	    (setq ENT_LINE (entget EN_LINE))
	    (wcmatch (cdr (assoc 0 ENT_LINE))
		     "LINE,ARC,LWPOLYLINE,SPLINE"
	    )
	    ;;
	    (setq SS (entsel "\n点取文字: "))
	    (setq EN_TEXT (car SS))
	    (setq ENT_TEXT (entget EN_TEXT))
	    (wcmatch (cdr (assoc 0 ENT_TEXT)) "TEXT,MTEXT")

	)
	(progn
	    (setq LST
		     (list '(5
			     ;;
			     (setq
			      TMP
			      (TT-01 EN_LINE VAL)
			      PT1
			      (car TMP)
			      ANG
			      (cadr TMP)
			     )
			     ;;
			     (TT-02 EN_TEXT VAL ANG)
			     	(vlax-get-property (vlax-ename->vla-object EN_text) 'InsertionPoint )
			     ;;
			     (redraw)
			     (grdraw VAL PT1 1)
			    )
			   ;;左击
			   '
			    (3
			     (redraw)
			     (setq TEST NIL)
			    )
			   '(25
			     (redraw)
			     (setq TEST NIL)
			    )
			   '(11
			     (redraw)
			     (setq TEST NIL)
			    )
		     )
	    )
	    (ZML-GRREAD LST)
	)
    )
    (princ)
)