标注系列【源码】，回馈明经

461045462

谢谢ebigsong 的分享
先下载收藏看看学习学习。

xiaoquansb

很好，很实用

laiz3000

好东西耶，俺也在学

gshix

不错，谢谢

lzg8877

我也在学 谢谢资料

lincctw_ccl

雖然用不到!還是給樓主

YAOSHIWEI

多谢楼主分享这么好的程序！！！

xieling888

必须支持！

fengshi0519

好东西，学习了，谢谢

vlisp2012

根据我的习惯，修改了一下！请大家指点！
;;;pn3.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))
       )   
     
     (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))
       )
     
     )

   (if (= g_yesorno 1) ;编组
      (progn
       ;建立选择集
       (setq obj_together (ssadd obj_txt (ssadd obj_line2 (ssadd obj_line))))
       ;生成匿名组
       (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)
)