[源码] 单行文本遮罩批量处理

admin

(defun c:wpt(/ os i ii ss ssn ssdata key box p1 p3 p2 p4 px1 py1 px3 py3 mx my mpt ee )
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))                ;取得捕捉形式               
  (setvar "osmode" 0)                   ;取消捕捉，如果不取消，会出错
(setq clay (getvar "CLAYER"))                ;层初始状态
;创建符号层sign颜色31
  (if (null (tblsearch "LAYER" "wipeout"))   ;如果wipeout层
  
   (command "采用layer" "采用m" "wipeout" "采用c" 251 "" "采用lt" "continuous"        "" "")  ;，创建wipeout层，并把遮罩层设为灰度251色

  )
(command "采用layer" "采用s" "wipeout" "") ;设为遮罩层
  
  (setq i 0)                               ;设循环起始点
  (setq ii 0)
  (setq ss (ssget))                        ;多选目标
  (repeat (sslength ss)                    ;循环目标数的次数
    (setq ssn (ssname ss i))               ;筛选出目标中的第i+1个对象名称
    (setq ssdata (entget ssn))             ;取出ssn中的数据
    (setq key (cdr (assoc 0 ssdata)))      ;取出关键字为0的列表
    (if (= key "TEXT")                     ;如果是单行文本
      (progn
        (setq ii (1+ ii))
         ;(setq ee1 (entlast))        ;文字临时赋值
         (command "ucs" "e" ssn)            ;以文字为参考坐标系
         (setq box (textbox ssdata))        ;测量并返回文字方框的对角坐标
         (setq p1 (car box))                ;取得一个角坐标
         (setq p3 (cadr box))               ;取得另对角坐标
         (setq p2 (list (car p3)(cadr p1))) ;取得另外角坐标
         (setq p4 (list (car p1)(cadr p3)))  ;取得另外角坐标
         (command "wipeout" p1 p2 p3 p4 "")  ;画遮罩部分
         
         (setq ee (entlast))                ;临时赋值
       
          ;以下求中心mpt
         (setq px1 (car p1))
         (setq py1 (cadr p1))
         (setq px3 (car p3))
         (setq py3 (cadr p3))
         (setq mx (/ (+ px1 px3) 2))
         (setq my (/ (+ py1 py3) 2))
       
         (setq mpt (list mx my))
       
         (command "scale"  ee ""  mpt 1.1)
         (command "copy" ssn "" mpt mpt )
         (entdel ssn)    ;删除原文字
       
      )
      
       ;(progn
         ;(prompt "无单行文字选项，退出！")
         ;(exit)
       ;)
      )
     
    (setq i (1+ i))   ;循环+1
    )
  (command "wipeout" "f" "off")             ;消除wipeout外边框
  (command "ucs" "")     ;返回世界坐标系
  (prin1)
  (setvar "osmode" os)     ;返回原始捕捉状态
  (setvar "CLAYER" clay)                ;返回图层初始状态
  (princ "\n 共处理了")(princ i ) (princ "个目标中的")(princ ii)(princ "个单行文字。感谢使用！")
  (prin1)
         
  )
(prompt "单行文字加外框遮罩程序<代替wipeout命令>***** <<wpt>>******")
(prin1)