楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vba还可以,应该用lisp能做的,vba应该也都能做吧
sscylh 发表于 2012-9-24 18:31 static/image/common/back.gif
楼主,不知道有vba您同意吗?我自己对lisp几乎一窍不通,就会些基础很常用,像vl函数都不会.............
vba还 ...
谢谢你，发过来看看，我是lsp初学者，如果能学习这方面的东东才更好
哈哈，来晚了，已经解决了
楼主是不是想得太多了。做成块或参照改一个对应图层其他的块不就都改了。
文本就设成属性，属性值可以不同。
附上源码：(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 / sattlst lst)
(if e
(progn
(setq s(entget e)
attlst'(1 7 404150 5162 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))))))
)
有个框选选项就好，有时不一定要全部改变的
顶一个
yjr111 发表于 2013-5-25 23:21 static/image/common/back.gif
附上源码：
怎么选择文字后就退出了。。。。
同上同上同上同上同上
cad2010、64位。