求文字格式刷lsp程序

sscylh · 发表于 2012-9-24 18:31:27

楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vba还可以,应该用lisp能做的,vba应该也都能做吧

品茗新秀 · 发表于 2012-9-24 18:36:37

sscylh 发表于 2012-9-24 18:31
楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vba还 ...

谢谢你，发过来看看，我是lsp初学者，如果能学习这方面的东东才更好

zyhandw · 发表于 2012-9-25 14:57:07

哈哈，来晚了，已经解决了

crazylsp · 发表于 2012-10-27 17:50:21

楼主是不是想得太多了。做成块或参照改一个对应图层其他的块不就都改了。

crazylsp · 发表于 2012-10-27 17:52:31

文本就设成属性，属性值可以不同。

yjr111 · 发表于 2013-5-25 23:21:59

附上源码：

(defun c:chta(/ e la ss bllst lst spwx spyx czwx czyx tp10 ssline
dist sstext mycad doc fuzz ssline dist)
(vl-load-com)
(vla-startUndoMark (setq doc(vla-get-ActiveDocument (setq mycad(vlax-get-acad-object)))))
(setq e(car(clh-entsel "\n选择单行文字:" "" '((0 . "TEXT")) "\n所选对像不是单行文本,请重新选择!"))
s(entget e)
ang(cdr(assoc 50 s))
)
(setq lst(gettextatt e))
(setq fuzz 5)
(if(not(assoc 62 lst))
(setq lst (cons '(62 . 256)lst))
)
(setq lst(vl-sort lst '(lambda(x y)(<(car x)(car y)))))
(setq tp10(cdr(assoc 10 s)))
(setq ssline(ssget "x" (list '(0 . "line")(assoc 8 s))))
(if ssline(setq dist(minpath_p2line tp10 ssline)))
(cond((and(or (not dist)(> dist 100)) (or (equal ang 0.0 0.1)(equal(rem ang 3.1415)0.0 0.1))) (setq dist 0)(setq spwx "1"))
((and(or (not dist)(> dist 100)) (or (equal ang 1.5708 0.1)(equal(rem ang 1.5708)0.0 0.1))) (setq dist 0)(setq czwx "1"))
((and(< dist 100) (or (equal ang 0.0 0.1)(equal(rem ang 3.1415)0.0 0.1))) (setq spyx "1"))
((and(< dist 100) (or (equal ang 1.5708 0.1)(equal(rem ang 1.5708)0.0 0.1))) (setq czyx "1"))
)
(setq sstext(ssget "X" (list '(0 . "TEXT")(assoc 8 s))))
(setq ss(ssadd))
(dlg)
(vla-zoomall mycad)
(cond
((= spwx "1")
(repeat (setq n(sslength sstext))
(setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n))))))))
(if (and(not(ssget "c" tp10 (list (- (car tp10)dist fuzz)(cadr tp10) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
(not(ssget "c" tp10 (list (+ (car tp10)dist fuzz)(cadr tp10) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
)
(ssadd e ss)
)
)
)
((= czwx "1")
(repeat (setq n(sslength sstext))
(setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n))))))))
(if (and(not(ssget "c" tp10 (list (car tp10)(- (cadr tp10)dist fuzz) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
(not(ssget "c" tp10 (list (car tp10)(+ (cadr tp10)dist fuzz) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
)
(ssadd e ss)
)
)
)
((= spyx "1")
(repeat (setq n(sslength sstext))
(setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n))))))))
(if (or(ssget "c" tp10 (list (- (car tp10)dist fuzz)(cadr tp10) 0.0)
(list '(0 . "line")(assoc 8 s))
)
(ssget "c" tp10 (list (+ (car tp10)dist fuzz)(cadr tp10) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
(ssadd e ss)
)
)
)
((= czyx "1")
(repeat (setq n(sslength sstext))
(setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n))))))))
(if (or(ssget "c" tp10 (list (car tp10)(- (cadr tp10)dist fuzz) 0.0)
(list '(0 . "line")(assoc 8 s))
)
(ssget "c" tp10 (list (car tp10)(+(cadr tp10)dist fuzz) 0.0)
(list '(0 . "line")(assoc 8 s))
)
)
(ssadd e ss)
)
)
)
)
(sssetfirst nil ss)
(cond((= std -1)(sssetfirst ss ss))
((= std 0)(changetextatt ss)(sssetfirst nil nil))
)
(vla-ZoomPrevious mycad)
(vla-endUndoMark doc)
(princ)
)
(defun gettextatt(e / s attlst lst)
(if e
(progn
(setq s(entget e)
attlst '(1 7 40 41 50 51 62 71)
)
(foreach x s (if (member (car x)attlst)(setq lst(cons x lst))))
)
)
lst
)
(defun changetextatt(ss / n m e s)
(if ss
(progn
(repeat (setq n(sslength ss))
(setq e (ssname ss (setq n(1- n)))
s (entget e)
)
(if(not(assoc 62 s))
(setq s (cons '(62 . 256)s))
)
(setq m 0)
(repeat (length bllst)
(if (= (eval (nth m bllst))"1")
(progn
(setq s(subst(nth m lst)(assoc (car (nth m lst))s)s))
(entmod s)
(entupd e)
)
)
(setq m(1+ m))
)
)
)
)
)
(defun setla()
(new_dialog "wzxx" id "" screenpt)
(SET_TILE "zfc" zfc)
(SET_TILE "yangsi" yangsi)
(SET_TILE "zg" zg)
(SET_TILE "zk" zk)
(SET_TILE "xzj" xzj)
(SET_TILE "qxj" qxj)
(SET_TILE "yanse" yanse)
(SET_TILE "scbz" scbz)
(SET_TILE "spwx" spwx)
(SET_TILE "spyx" spyx)
(SET_TILE "czwx" czwx)
(SET_TILE "czyx" czyx)
(action_tile "zfc" "(setq zfc $value)")
(action_tile "yangsi" "(setq yangsi $value)")
(action_tile "tc" "(setq tc $value)")
(action_tile "zk" "(setq zk $value)")
(action_tile "zg" "(setq zg $value)")
(action_tile "xzj" "(setq xzj $value)")
(action_tile "qxj" "(setq qxj $value)")
(action_tile "yanse" "(setq yanse $value)")
(action_tile "scbz" "(setq scbz $value)")
(action_tile "spwx" "(setq spwx $value)")
(action_tile "spyx" "(setq spyx $value)")
(action_tile "czwx" "(setq czwx $value)")
(action_tile "czyx" "(setq czyx $value)")
(action_tile "accept" "(setq screenpt(done_dialog))")
(action_tile "cancel" "(setq screenpt(done_dialog -1))")
(setq std(START_DIALOG))
)
(DEFUN DLG(/ n fn lsdcl id )
(setq bllst'(zfc yangsi zg zk xzj qxj yanse scbz))
(foreach x bllst(if (not (eval x))(set x "0")))
(if (not spwx)(setq spwx "0"))
(if (not spyx)(setq spyx "0"))
(if (not czwx)(setq czwx "0"))
(if (not czyx)(setq czyx "0"))
(setq fn (open (setq lsdcl (VL-FILENAME-MKTEMP "tmp" "" ".dcl")) "w"))
(write-line "wzxx:dialog{" fn)
(write-line " label="文字选项";" fn)
(write-line " :column{" fn)
(write-line " :boxed_row{" fn)
(write-line " label="匹配选项";" fn)
(write-line " :column{" fn)
(write-line " :toggle{label="匹配字内容";key="zfc";}" fn)
(write-line " :toggle{label="匹配字样式";key="yangsi";}" fn)
(write-line " :toggle{label="匹配字高度";key="zg";}" fn)
(write-line " :toggle{label="匹配字宽度";key="zk";}" fn)
(write-line " }" fn)
(write-line " :column{" fn)
(write-line " :toggle{label="匹配旋转角";key="xzj";}" fn)
(write-line " :toggle{label="匹配倾斜角";key="qxj";}" fn)
(write-line " :toggle{label="匹配字颜色";key="yanse";}" fn)
(write-line " :toggle{label="匹配字方向";key="scbz";}" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :boxed_row{" fn)
(write-line " label="线字组合选项";" fn)
(write-line " :column{" fn)
(write-line " :radio_button{label="水平无线";key="spwx";}" fn)
(write-line " :radio_button{label="水平有线";key="spyx";}" fn)
(write-line " :radio_button{label="垂直无线";key="czwx";}" fn)
(write-line " :radio_button{label="垂直有线";key="czyx";}" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :row{" fn)
(write-line " :button{label="确定";key="accept";is_default=true;}" fn)
(write-line " :button{label="取消";key="cancel";is_cancel=true;}" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " }" fn)
(close fn)
(setq id (LOAD_DIALOG lsdcl))
(setla)
(unload_dialog id)
(VL-FILE-DELETE lsdcl)
)
(defun clh-entsel (msg key fil ermsg / el ss)
(while
(and (setvar "errno" 0)
(not
(and (setq el (apply '(lambda (msg key) (initget key) (entsel msg))
(list msg key)
)
)
(if (= (type el) 'str)
el
(if (setq ss (ssget (cadr el) fil))
ss
(progn (princ ermsg) (setq ss nil))
)
)
)
)
(/= (getvar "errno") 52)
)
)
el
)
(defun minpath_p2line(point ssent / n jllst dis)
(repeat (setq n(sslength ssent))
(setq jllst(cons (list (distance point (vlax-curve-getclosestpointto (setq e(ssname ssent (setq n(1- n)))) point))e) jllst))
)
(setq dis(caar(vl-sort jllst '(lambda(x y)(<(car x)(car y))))))
)

(defun c:chta(/ e la ss bllst lst spwx spyx czwx czyx tp10 ssline 
                dist sstext mycad doc fuzz ssline dist) 
  (vl-load-com)   
  (vla-startUndoMark (setq doc(vla-get-ActiveDocument (setq mycad(vlax-get-acad-object))))) 
  (setq e(car(clh-entsel  "\n选择单行文字:"  ""   '((0 . "TEXT"))  "\n所选对像不是单行文本,请重新选择!")) 
        s(entget e) 
        ang(cdr(assoc 50 s)) 
        ) 
  (setq lst(gettextatt e)) 
  (setq fuzz 5) 
  (if(not(assoc 62 lst)) 
    (setq lst (cons '(62 . 256)lst)) 
    ) 
  (setq lst(vl-sort lst '(lambda(x y)(<(car x)(car y))))) 
  (setq tp10(cdr(assoc 10 s))) 
  (setq ssline(ssget "x" (list '(0 . "line")(assoc 8 s)))) 
  (if ssline(setq dist(minpath_p2line tp10 ssline))) 
  (cond((and(or (not dist)(> dist 100)) (or (equal ang 0.0 0.1)(equal(rem ang 3.1415)0.0 0.1))) (setq dist 0)(setq spwx "1")) 
       ((and(or (not dist)(> dist 100)) (or (equal ang 1.5708 0.1)(equal(rem ang 1.5708)0.0 0.1))) (setq dist 0)(setq czwx "1")) 
       ((and(< dist 100) (or (equal ang 0.0 0.1)(equal(rem ang 3.1415)0.0 0.1))) (setq spyx "1")) 
       ((and(< dist 100) (or (equal ang 1.5708 0.1)(equal(rem ang 1.5708)0.0 0.1))) (setq czyx "1")) 
       ) 
  (setq sstext(ssget "X" (list '(0 . "TEXT")(assoc 8 s)))) 
  (setq ss(ssadd)) 
  (dlg) 
  (vla-zoomall mycad) 
  (cond 
    ((= spwx "1")      
     (repeat (setq n(sslength sstext)) 
       (setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n)))))))) 
       (if (and(not(ssget "c" tp10 (list (- (car tp10)dist fuzz)(cadr tp10) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
               ) 
              (not(ssget "c" tp10 (list (+ (car tp10)dist fuzz)(cadr tp10) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
               ) 
              ) 
         (ssadd e ss) 
         ) 
       ) 
     ) 
    ((= czwx "1") 
     (repeat (setq n(sslength sstext)) 
       (setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n)))))))) 
       (if (and(not(ssget "c" tp10  (list (car tp10)(- (cadr tp10)dist fuzz) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
               ) 
              (not(ssget "c" tp10  (list (car tp10)(+ (cadr tp10)dist fuzz) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
               ) 
              ) 
         (ssadd e ss) 
         ) 
       ) 
     ) 
    ((= spyx "1") 
     (repeat (setq n(sslength sstext)) 
       (setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n)))))))) 
       (if (or(ssget "c" tp10 (list (- (car tp10)dist fuzz)(cadr tp10) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
              (ssget "c" tp10 (list (+ (car tp10)dist fuzz)(cadr tp10) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
              ) 
         (ssadd e ss) 
         ) 
       ) 
    ) 
   ((= czyx "1") 
     (repeat (setq n(sslength sstext)) 
       (setq tp10(cdr(assoc 10 (entget(setq e(ssname sstext (setq n(1- n)))))))) 
       (if (or(ssget "c" tp10  (list (car tp10)(- (cadr tp10)dist fuzz) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
              (ssget "c" tp10 (list (car tp10)(+(cadr tp10)dist fuzz) 0.0) 
                  (list '(0 . "line")(assoc 8 s)) 
                  ) 
              ) 
         (ssadd e ss) 
         ) 
       ) 
    ) 
   ) 
  (sssetfirst nil ss)   
  (cond((= std -1)(sssetfirst ss ss)) 
       ((= std 0)(changetextatt ss)(sssetfirst nil nil))       
  ) 
  (vla-ZoomPrevious mycad) 
  (vla-endUndoMark doc) 
  (princ) 
  ) 
(defun gettextatt(e / s  attlst lst) 
  (if e 
    (progn 
      (setq s(entget e) 
            attlst  '(1   7   40  41  50   51  62    71) 
            ) 
      (foreach x s (if (member (car x)attlst)(setq lst(cons x lst)))) 
      ) 
    ) 
  lst 
  ) 
(defun changetextatt(ss / n m e s) 
  (if ss 
    (progn 
      (repeat (setq n(sslength ss)) 
        (setq e (ssname ss (setq n(1- n))) 
              s (entget e) 
              ) 
        (if(not(assoc 62 s)) 
           (setq s (cons '(62 . 256)s)) 
        ) 
        (setq m 0) 
        (repeat (length bllst) 
          (if (= (eval (nth m bllst))"1") 
            (progn 
            (setq s(subst(nth m lst)(assoc (car (nth m lst))s)s)) 
            (entmod s) 
            (entupd e) 
            ) 
            ) 
          (setq m(1+ m)) 
          ) 
        ) 
      ) 
    ) 
  ) 
 (defun setla() 
          (new_dialog "wzxx" id "" screenpt) 
          (SET_TILE "zfc" zfc) 
          (SET_TILE "yangsi" yangsi) 
          (SET_TILE "zg" zg) 
          (SET_TILE "zk" zk) 
          (SET_TILE "xzj" xzj) 
          (SET_TILE "qxj" qxj) 
          (SET_TILE "yanse" yanse) 
          (SET_TILE "scbz" scbz) 
          (SET_TILE "spwx" spwx) 
          (SET_TILE "spyx" spyx) 
          (SET_TILE "czwx" czwx) 
          (SET_TILE "czyx" czyx) 
          (action_tile "zfc" "(setq zfc $value)") 
          (action_tile "yangsi" "(setq yangsi $value)") 
          (action_tile "tc" "(setq tc $value)") 
          (action_tile "zk" "(setq zk $value)") 
          (action_tile "zg" "(setq zg $value)") 
          (action_tile "xzj" "(setq xzj $value)") 
          (action_tile "qxj" "(setq qxj $value)") 
          (action_tile "yanse" "(setq yanse $value)") 
          (action_tile "scbz" "(setq scbz $value)") 
          (action_tile "spwx" "(setq spwx $value)") 
          (action_tile "spyx" "(setq spyx $value)") 
          (action_tile "czwx" "(setq czwx $value)") 
          (action_tile "czyx" "(setq czyx $value)") 
          (action_tile "accept" "(setq screenpt(done_dialog))") 
          (action_tile "cancel" "(setq screenpt(done_dialog -1))") 
          (setq std(START_DIALOG)) 
        ) 
 (DEFUN DLG(/ n fn lsdcl id )    
    (setq bllst'(zfc yangsi zg zk xzj qxj yanse scbz)) 
    (foreach x bllst(if (not (eval x))(set x "0"))) 
    (if (not spwx)(setq spwx "0")) 
    (if (not spyx)(setq spyx "0")) 
    (if (not czwx)(setq czwx "0")) 
    (if (not czyx)(setq czyx "0")) 
    (setq fn (open (setq lsdcl (VL-FILENAME-MKTEMP "tmp" "" ".dcl")) "w")) 
        (write-line "wzxx:dialog{" fn) 
        (write-line "   label="文字选项";" fn) 
        (write-line "   :column{" fn) 
        (write-line "   :boxed_row{" fn) 
        (write-line "   label="匹配选项";" fn) 
        (write-line "   :column{" fn) 
        (write-line "        :toggle{label="匹配字内容";key="zfc";}" fn) 
        (write-line "        :toggle{label="匹配字样式";key="yangsi";}" fn) 
        (write-line "        :toggle{label="匹配字高度";key="zg";}" fn) 
        (write-line "        :toggle{label="匹配字宽度";key="zk";}" fn) 
        (write-line "        }" fn) 
        (write-line "   :column{" fn) 
        (write-line "        :toggle{label="匹配旋转角";key="xzj";}" fn) 
        (write-line "        :toggle{label="匹配倾斜角";key="qxj";}" fn) 
        (write-line "        :toggle{label="匹配字颜色";key="yanse";}" fn) 
        (write-line "        :toggle{label="匹配字方向";key="scbz";}" fn) 
        (write-line "        }" fn) 
        (write-line "        }" fn) 
        (write-line "   :boxed_row{" fn) 
        (write-line "   label="线字组合选项";" fn) 
        (write-line "   :column{" fn) 
        (write-line "        :radio_button{label="水平无线";key="spwx";}" fn) 
        (write-line "        :radio_button{label="水平有线";key="spyx";}" fn) 
        (write-line "        :radio_button{label="垂直无线";key="czwx";}" fn) 
        (write-line "        :radio_button{label="垂直有线";key="czyx";}" fn) 
        (write-line "        }" fn) 
        (write-line "        }" fn) 
        (write-line "   :row{" fn) 
        (write-line "        :button{label="确定";key="accept";is_default=true;}" fn) 
        (write-line "        :button{label="取消";key="cancel";is_cancel=true;}" fn) 
        (write-line "        }" fn) 
        (write-line "        }" fn)         
        (write-line "        }" fn) 
        (close fn) 
        (setq id (LOAD_DIALOG lsdcl)) 
        (setla) 
        (unload_dialog id) 
        (VL-FILE-DELETE lsdcl) 
   ) 
(defun clh-entsel (msg key fil ermsg / el ss) 
 (while 
  (and (setvar "errno" 0) 
       (not 
        (and (setq el (apply '(lambda (msg key) (initget key) (entsel msg)) 
                             (list msg key) 
                      ) 
             ) 
             (if (= (type el) 'str) 
              el 
              (if (setq ss (ssget (cadr el) fil)) 
               ss 
               (progn (princ ermsg) (setq ss nil)) 
              ) 
             ) 
        ) 
       ) 
       (/= (getvar "errno") 52) 
  ) 
 ) 
 el 
) 
(defun minpath_p2line(point ssent / n jllst dis) 
  (repeat (setq n(sslength ssent)) 
    (setq jllst(cons (list (distance point (vlax-curve-getclosestpointto (setq e(ssname ssent (setq n(1- n)))) point))e) jllst)) 
    ) 
  (setq dis(caar(vl-sort jllst '(lambda(x y)(<(car x)(car y)))))) 
)

bai2000 · 发表于 2013-5-26 17:42:29

有个框选选项就好，有时不一定要全部改变的

yy539539 · 发表于 2013-7-17 17:10:31

顶一个

njut_prince · 发表于 2013-9-29 11:01:59

yjr111 发表于 2013-5-25 23:21
附上源码：

怎么选择文字后就退出了。。。。

ZX13901146068 · 发表于 2014-10-18 11:23:38

同上同上同上同上同上
cad2010、64位。

账号		自动登录	找回密码
密码			注册

求文字格式刷lsp程序

点评

点评