- 积分
- 66818
- 明经币
- 个
- 注册时间
- 2011-11-2
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2012-11-27 21:47:16
|
显示全部楼层
刚刚又从新修改了一下：
;;;pn4.lsp
;;;给选择的对象添加文字标注
;;;输入：选择对象和标注的点位，输入标注文字
;;;输出：生成引线及标注文字。
;;;最后修改时间：2012.4.8
;(defun *error* (msg) exit)
(defun C:pn4()
;;;(setq r 1)
(setq lg_layer "W_DIM");设置标注图层
(setq txt_style "hztxt");立管标注样式
(setq g_yesorno 1);设置是否编组，0-不编组，1-编组
;;;(setq txt_size (* r 6)) ;设置标注文字高度
(setq txt_size (GETVAR "TEXTSIZE" )) ;设置标注文字高度
(setq txt_off1 (/ txt_size 4)) ;设置标注文字上移尺寸
(setq txt_off2 (* txt_size 1)) ;设置标注文字左右移尺寸
(setvar"cmdecho"0)
(setq var_os (getvar "osmode"));记录捕捉
(setq var_old_layer (getvar "clayer"));记录当前图层
;判断图层是否存在
(if (= nil (tblsearch "layer" lg_layer)) (command "layer" "m" lg_layer ""))
;提示选择对象，获得选择点
(setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
(while inspt
(progn
(setvar "clayer" lg_layer);设置当前图层
(setvar "osmode" 0);取消捕捉
(setq inspt1 (getpoint inspt "\n点取标注位置"))
;绘制连接线
(command "line" inspt inspt1 "")
(setq obj_line (entlast))
(setq txt (getstring "\n标注内容: "))
(setq ang (* (/ (angle inspt inspt1) pi) 180))
(if (or (<= ang 90) (>= ang 270))
(progn
;输入名称和编号
(command "text" ;|"J" "bl"|; inspt1 txt_size "0" txt)
;选择最后一个图元名
(setq obj_txt (entlast))
(command "move" obj_txt "" inspt1 (strcat "@" (rtos txt_off2) "," (rtos txt_off1)))
;绘制标注底线
(setq txtb (textbox (entget obj_txt)))
;得到文字长度
(setq txt_l (- (caadr txtb) (caar txtb)))
(command "line" inspt1 (strcat "@" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
(setq obj_line2 (entlast))
(command "pline" inspt inspt1 (strcat "@" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
(setq obj_line3 (entlast))
(command "erase" obj_line obj_line2 "")
)
(progn
;输入名称和编号
(command "text" "J" "r" inspt1 txt_size "0" txt)
;选择最后一个图元名
(setq obj_txt (entlast))
(command "move" obj_txt "" inspt1 (strcat "@-" (rtos txt_off2) "," (rtos txt_off1)))
;绘制标注底线
(setq txtb (textbox (entget obj_txt)))
;得到文字长度
(setq txt_l (- (caadr txtb) (caar txtb)))
(command "line" inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
(setq obj_line2 (entlast))
(command "pline" inspt inspt1 (strcat "@-" (rtos (+ txt_l (* txt_off2 2))) ",0") "")
(setq obj_line3 (entlast))
(command "erase" obj_line obj_line2 "")
)
)
(if (= g_yesorno 1) ;编组
(progn
;建立选择集
(setq obj_together (ssadd obj_txt (ssadd obj_line3 )))
;生成匿名组
(command "-group" "c" "*" "对象标注" obj_together "")
)
)
(setvar "osmode" var_os);恢复捕捉
(setvar "clayer" var_old_layer);恢复当前图层
(princ)
;提示选择对象，获得选择点
(setq inspt (osnap (cadr (entsel "\n选择标注对象")) "nea"))
);end progn
);end while
(princ)
) |
|
[复制链接]
显身卡
[em0]