 - [FONT=courier new];;;程序tel用于在直线中插入文字
- (defun c:tel ()
- (prompt "Please select a line!!!")
- (setq ss (ssget '((0 . "LINE"))))
- (if (/= ss nil)
- (progn
- ;;计算直线的角度
- (setq s (ssname ss 0)
- pt_ln_sta (cdr (assoc 10 (entget s)))
- pt_ln_end (cdr (assoc 11 (entget s)))
- ang_ln (angle pt_ln_sta pt_ln_end)
- ang_tx ang_ln
- )
- (if (and (> ang_ln (angtof "100")) (<= ang_ln (angtof "180")))
- (setq ang_tx (+ ang_ln (angtof "180")))
- (if (and (> ang_ln (angtof "180")) (<= ang_ln (angtof "280")))
- (setq ang_tx (- ang_ln (angtof "180")))
- )
- )
- ;;初始化比例、字高
- (setq ang_mov (+ ang_ln (angtof "90")))
- (if (= high_tel nil)
- (progn
- (setq sca_ft 1)
- (setq high_tel 300)
- )
- (setq sca_ft 1)
- )
- (setq tx_size (getvar "textsize"))
- ;;确定文字值
- (if (= tx_val_il nil)
- (setq tx_val_il "F")
- )
- (prompt (strcat "Please input the symbol to be insert:<"
- tx_val_il
- ">"
- )
- )
- (setq tmp (getstring "\n输入字符: "))
- (if (/= tmp "")
- (setq tx_val_il tmp)
- )
- ;;计算直线打断宽度
- (setvar "textsize" high_tel)
- (command "text" "j" "m" "0,0" "" "" tx_val_il)
- (setq wid_br (textbox (list (assoc 1 (entget (entlast)))))
- pt_bk_a (car wid_br)
- pt_bk_b (cadr wid_br)
- wid_br (/ (- (car pt_bk_b) (car pt_bk_a)) 2)
- wid_br (+ wid_br (* 0.8 sca_ft))
- )
- (setvar "textsize" tx_size)
- (command "erase" (entlast) "")
- ;;指定文字近似插入点
- (setq os_mode (getvar "osmode"))
- (setvar "osmode" 0)
- (setq pt_tx_tp (getpoint "\nPlease choose the text position!!!"))
- ;;循环开始
- (while (/= pt_tx_tp nil) ;计算文字插入点(精确)
- (setq pt_tx (polar pt_tx_tp ang_mov 10)
- pt_tx (inters pt_ln_sta pt_ln_end pt_tx_tp pt_tx nil)
- ss (ssget "c" pt_tx pt_tx '((0 . "LINE")))
- )
- (if (/= ss nil)
- (progn
- (setq pt_bk_b (sslength ss)
- pt_bk_a 0
- ln_find 0
- )
- (while (and (= ln_find 0) (< pt_bk_a pt_bk_b))
- (setq s (ssname ss pt_bk_a)
- ang_ln_tp (angle (cdr (assoc 10 (entget s)))
- (cdr (assoc 11 (entget s)))
- )
- pt_bk_a (1+ pt_bk_a)
- )
- (if (= (angtos ang_ln_tp) (angtos ang_ln)) ;直线找到
- (progn
- (setq ln_find 1)
- (setvar "textsize" high_tel) ;写
- (command "text" "j" "m" pt_tx "" (angtos ang_tx) tx_val_il)
- (setvar "textsize" tx_size)
- (setq pt_bk_a (polar pt_tx ang_ln wid_br)
- pt_bk_b (polar pt_tx (+ Pi ang_ln) wid_br)
- ) ;确定直线打断点
- (command "break" s pt_bk_a pt_bk_b) ;打断直线
- )
- )
- )
- )
- )
- (setq pt_tx_tp (getpoint "\nPlease choose the next position!!!"))
- )
- (setvar "osmode" os_mode)
- )
- )
- (princ)
- )[/FONT]
|