日志
文字插线
||
;;;思路源于:http://tel.tstmr.com/dispbbs.asp?boardid=7&Id=2595
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;功能: 文字插线并断开线
;;;命令: textbreakline 或tbl
;;;作者: carrot1983 2008-11-06
;|//DCL的文件名保存为: textbreakline.dcl
//并将dcl保存到CAD的搜索路径 或者编译成 VLX格式
tbl:dialog {
label = "文字插线 carrot" ;
:popup_list {
key = "layer" ;
label = "图层:" ;
}
:popup_list {
key = "style" ;
label = "样式:" ;
}
:edit_box {
key = "height" ;
label = "字高:" ;
}
:edit_box {
key = "width" ;
label = "断宽:" ;
}
:edit_box {
key = "text" ;
label = "文本:" ;
}
ok_cancel;
}
|;
(defun c:textbreakline (/ clayer cmdecho dclfna dclid dclna
e el ent layers okid pt
styles
)
(vl-load-com)
;;
;; 对话框
;;
(defun dialog ()
;;
;; 通用函数: 符号表
;;
(defun jw-tblnext (name item / list0 list1 listn)
(if (setq list0 (tblnext name t))
(progn
(setq listn (cons (cdr (assoc item list0)) listn))
(while (setq list1 (tblnext name))
(setq listn (cons (cdr (assoc item list1)) listn))
)
)
)
(reverse listn)
)
(setq dclfna "textbreakline.dcl")
(setq dclna "tbl")
;;1.1.
(setq dclid (load_dialog dclfna))
(if (< dclid 0)
(progn (alert (strcat dclfna " 文件不存在!!!"))
(exit)
)
)
;;1.2.
(if (not (new_dialog dclna dclid ""))
(exit)
)
;;1.3.
(start_list "layer")
(mapcar 'add_list (setq layers (jw-tblnext "layer" 2)))
(end_list)
(start_list "style")
(mapcar 'add_list (setq styles (jw-tblnext "style" 2)))
(end_list)
;;1.4.
(if *layer
(set_tile "layer" *layer)
(set_tile "layer" "0")
)
(if *style
(set_tile "style" *style)
(set_tile "style" "0")
)
(if *height
(set_tile "height" *height)
(set_tile "height" "300")
)
;;打断宽度
(if *width
(set_tile "width" *width)
(set_tile "width" "375")
)
(if *text
(set_tile "text" *text)
(set_tile "text" "NO")
)
;;1.6.1
(defun dclmain ()
(setq *layer (get_tile "layer"))
(setq *style (get_tile "style"))
(setq *height (get_tile "height"))
(setq *width (get_tile "width"))
(setq *text (get_tile "text"))
)
;;1.6.
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(dclmain) (done_dialog 1)")
;;1.7.
(setq okid (start_dialog))
(unload_dialog dclid)
)
;;
;; 主程序
;;
(setq cmdecho (getvar "cmdecho"))
(setq clayer (getvar "clayer"))
(setvar "cmdecho" 0)
;;1.
(dialog)
;;2.
(cond ((= okid 1)
(while (setq ent (entsel "\n选择插入点:"))
(command "._undo" "begin")
(setq e (car ent)
pt (cadr ent)
pt (vlax-curve-getclosestpointto e pt)
)
(command "circle" "none" pt (read *width))
(setq el (entlast))
(command "trim" el "" "none" (list e pt) "")
(setvar "clayer" (nth (read *layer) layers))
(command "text"
"s"
(nth (read *style) styles)
"J"
"M"
"none"
pt
(read *height)
""
*text
)
(setvar "clayer" clayer)
(command "erase" el "")
(command "._undo" "end")
)
)
)
(setvar "cmdecho" cmdecho)
(princ)
)
(defun c:tbl ()
(c:textbreakline)
)
(princ)
