;~~~~~~~~~~~~~~~~~~改变所有字型型式(cf)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:cf()
(setq hh(getstring "请输入font style:" ))
(setq ss (ssget "X" '((0 . "TEXT"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq old_hh (assoc 7 ssdata))
(setq new_hh (cons 7 hh))
(setq ssdata (subst new_hh old_hh ssdata))
(entmod ssdata)
(setq i (1+ i))
)
)
;~~~~~~~~~~~~~~~~~~改变所有字型型式(cf)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~改变所有text的高度(ch)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:ch()
(prompt "***改TEXT可用***更改图面text高度")
(setq oldh(getreal "\n请输入欲修改文字的高度<全部text都改直接按enter>:" ))
(setq newh(getreal "\n请输入修改后文字高度:" ))
(if (= oldh nil)
(progn
(setq ss (ssget "X" '((0 . "TEXT"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq old_hh (assoc 40 ssdata))
(setq new_hh (cons 40 newh))
(setq ssdata (subst new_hh old_hh ssdata))
(entmod ssdata)
(setq i (1+ i))
);end repeat
);end progn
(progn
(setq ss(ssget "X" (list(cons 0 "TEXT")(cons 40 oldh))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq old_hh (assoc 40 ssdata))
(setq new_hh (cons 40 newh))
(setq ssdata (subst new_hh old_hh ssdata))
(entmod ssdata)
(setq i (1+ i))
)
)
);end if
)
;~~~~~~~~~~~~~~~~~~改变所有text的高度(ch)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~替代文字内容(ct)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:ct()
(prompt "***改TEXT可用***此指令将图档内所有文字替换 如:将所有的~碳纤~文字 替换成~碳纤维~文字 ")
(setq oldtxt (getstring t "\n请输入原始文字内容:"))
(setq newtxt (getstring t "\n请输入更变后文字内容:"))
;(ssget "x" '((-4 . "<not")(-4 . "<or")(62 . 1)(62 . 5)(-4 . "or>")(-4 . "not>")))
;~~~~~~text型式的文字~~~~~~~~~~
(setq ss(ssget "X" '((0 . "text"))))
(setq oldnum (strlen oldtxt));旧字串长度
(setq newnum (strlen newtxt));新字串长度
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq sstyp (cdr (assoc 0 ssdata)))
(setq p 1)
(setq ent (assoc 1 ssdata))
(setq entxt (cdr ent))
(setq ennum (strlen entxt))
(setq aa "")
(while (<= p ennum)
(setq kk (substr entxt p oldnum))
(if (= kk oldtxt)
(progn
(setq kk newtxt)
(setq p (- (+ p oldnum) 1))
)
(setq kk (substr entxt p 1))
);end if
(setq aa (strcat aa kk))
(setq p (1+ p))
);end while
(setq aa (cons 1 aa))
(setq ssdata (subst aa ent ssdata))
(entmod ssdata)
(setq i (1+ i))
);end repeat
;~~~~~~text型式的文字****到此结束~~~~~~~~~~
;~~~~~~Mtext型式的文字~~~~~~~~~~
(setq ssm(ssget "X" '((0 . "MTEXT"))))
(setq oldnum (strlen oldtxt))
(setq newnum (strlen newtxt))
(setq j 0)
(repeat (sslength ssm)
(setq ssn (ssname ssm j))
(setq ssdata (entget ssn))
(setq sstyp (cdr (assoc 0 ssdata)))
(setq p 1)
(setq ent (assoc 1 ssdata))
(setq entxt (cdr ent))
(setq ennum (strlen entxt))
(setq aa "")
(while (<= p ennum)
(setq kk (substr entxt p oldnum))
(if (= kk oldtxt)
(progn
(setq kk newtxt)
(setq p (- (+ p oldnum) 1))
)
(setq kk (substr entxt p 1))
)
(setq aa (strcat aa kk))
(setq p (1+ p))
)
(setq aa (cons 1 aa))
(setq ssdata (subst aa ent ssdata))
(entmod ssdata)
(setq j (1+ j))
);end repeat
)
;
;~~~~~~~~~~~~~~~~~~替代文字内容(ct)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;~~~~~~~~~~~~~~~~~~改变线宽内容(cw)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(defun c:cw()
(setvar "cmdecho" 0)
(setq ww (getdist "\n宽度 <1>: "))
(if (= ww nil) (setq ww 1.0))
(setq ss (ssget))
(setq s 0)
(repeat (sslength ss)
(setq ssn (ssname ss s))
(setq entyp (cdr (assoc 0 (entget ssn))))
(cond ((= entyp "CIRCLE") (progn
(setq rr (cdr (assoc 40 (entget ssn))))
(setq cen (cdr (assoc 10 (entget ssn))))
(command "donut" (* 2 (- rr (/ ww 2))) (* 2 (+ rr (/ ww 2))) cen "")
(command "erase" ssn "")
))
((= entyp "LINE") (command "pedit" ssn "y" "w" ww ""))
((= entyp "ARC") (command "pedit" ssn "y" "w" ww ""))
((= entyp "LWPOLYLINE") (command "pedit" ssn "w" ww ""))
((= entyp "POLYLINE") (command "pedit" ssn "w" ww ""))
)
(setq s (1+ s))
)
)
;~~~~~~~~~~~~~~~~~~改变线宽内容(cw)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;********************将选择text数字加总(to)************
(defun c:to(/ ce i data1 textcont totaltext totaldec seltext ssn1)
(setq ce(getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq totaltext 0)
(setq seltext "")
(setq ssn1(entsel "\n请选取欲加总文字1(text):"))
(setq i 2)
(redraw (car ssn1) 3);Highlight entity
(while (/= ssn1 nil)
(setq data1(entget (car ssn1)))
(setq textcont(cdr (assoc 1 data1)))
(setq totaltext(+ totaltext (atof textcont)) )
(setq totaldec(rtos totaltext 2 0))
(setq seltext(strcat seltext "+" textcont ))
(setq ssn1(entsel (strcat "\n请选取欲加总文字" (rtos i 2 2) "(text):")))
(if (/= ssn1 nil)
(redraw (car ssn1) 3);Highlight entity
);end if
;(setq ssn1 ssn2)
(setq i(+ i 1))
);end while
(setq result(strcat seltext "=" totaldec))
(command "text" pause "" "" result)
;(princ result)
; (setvar "cmdecho" ce)
);end defun
;********************将选择text数字加总(to)************
;********************将面积写出成text(atx)************
(defun c:atx ()
;(command "style" "romans" "romans" "0" "1" "0" "n" "n" "n")
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "area" "e" pause)
(setq v1(rtos(getvar "area")2 0));取得面积 Perimeter取得周长
(setvar "cmdecho" ce)
(command "text" pause "" "" v1 "")
);end defun
(prompt "\n(to)将选择text数字加总")
(prompt "\n(atx) 将面积写出成text")
;********************将面积写出成text(atx)************
;********************将周长写出成text(ltx)************
(defun c:ltx ()
(command "style" "romans" "romans" "0" "1" "0" "n" "n" "n")
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "area" "e" pause)
(setq v1(rtos(getvar "perimeter")2 0));取得面积 Perimeter取得周长
(setvar "cmdecho" ce)
(command "text" pause "" "" v1 "")
);end defun
(prompt "\n(to)将选择text数字加总")
(prompt "\n(ltx) 将长度写出成text")
(prompt "\nCreated by charchin lin 2001 Dec")
;********************将周长写出成text(ltx)************
;****************将选取文字写出至txt档(wf)*********************
(defun c:wf()
(setq dat_file (getfiled "写档" "c:\\temp\\text1" "txt" 1))
;(setq en1(entsel "\n请点选第1个文字<按Esc键取消><按enter换行>:"))
;(redraw (car en1) 3);Highlight entity
(setq i 2 )
(while (> i 1)
(setq ff (open dat_file "a"))
(setq stick "")
(setq en1(entsel "\n请点选第1个文字<按Esc键取消><按enter换行>:"))
(redraw (car en1) 3);Highlight entity
(while (/= en1 nil)
(setq data1(entget (car en1)))
(setq s1t(cdr (assoc 1 data1)))
(setq newstring(strcat "," s1t))
(setq stick(strcat stick newstring));累积串
(setq en1(entsel "\n请点选下一个文字<按Esc键取消><按enter换行>:"))
(if (/= en1 nil)
(redraw (car en1) 3);Highlight entity
);end if
(setq i 5)
);end while
(write-line stick ff)
(close ff)
(setq i 3)
);end while
; (prin1)
);end defun
(prompt "Created by charchin lin 2001 Dec")
;****************将选取文字写出至txt(wf)*********************
;***************选点写出x,y座标(xy)*****************
(defun c:xy()
(setq point(getpoint "点选位置:"))
(setq crad(getreal "输入半径or字高:"))
(setq osnap_v(getvar "osmode")) ;取出osnap值
(setvar "osmode" 0 );并且关闭 以免影响lisp图
(setq tpoint1(polar point (* -0.25 pi) (* 1.8 crad)) )
(setq tpoint2(polar point (* -0.361 pi) (* 3 crad)))
(setq tpx(strcat "E=" (rtos(car point) 2 3) ));
(setq tpy(strcat "N=" (rtos(cadr point) 2 3) ));
(command "point" point)
(command "text" tpoint2 crad "" tpx )
(command "text" tpoint1 crad "" tpy )
;(circ point crad)
(setvar "osmode" osnap_v );恢复原来抓点模式设定
(while (/= point nil)
(setq point(getpoint "点选位置:"))
(setq osnap_v(getvar "osmode")) ;取出osnap值
(setvar "osmode" 0 );并且关闭 以免影响lisp图
(setq tpoint1(polar point (* -0.25 pi) (* 1.8 crad)) )
(setq tpoint2(polar point (* -0.361 pi) (* 3 crad)))
(setq tpx(strcat "E=" (rtos(car point) 2 3) ));
(setq tpy(strcat "N=" (rtos(cadr point) 2 3) ));
(command "point" point)
(command "text" tpoint2 crad "" tpx )
(command "text" tpoint1 crad "" tpy )
;(circ point crad)
(setvar "osmode" osnap_v );恢复原来抓点模式设定
);end while
(setvar "osmode" osnap_v );恢复原来抓点模式设定
)
;***************选点写出x,y座标(xy)*****************
;****************副涵数 输入 座标及半径 划出圆及中心十字*********************
(defun circ(cp rad)
(setq x1(- (car cp) (* 2 rad)))
(setq y1(cadr cp))
(setq pt1(list x1 y1))
(setq x2(+ (car cp) (* 2 rad)))
(setq pt2(list x2 y1))
(setq y3(+ (cadr cp) (* 2 rad)))
(setq x3(car cp))
(setq pt3(list x3 y3))
(setq y4(- (cadr cp) (* 2 rad)))
(setq pt4(list x3 y4))
(setq x11(- (car cp) rad))
(setq y11(cadr cp))
(setq pt5(list x11 y11));pt5&pt6为圆直径
(setq x12(+ (car cp) rad))
(setq pt6(list x12 y11));pt5&pt6为圆直径
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(command "circle" cp rad);圆
)
;****************副涵数 输入 座标及半径 划出圆及中心十字*********************
;****************n1文字加编号(如:b2f-1 b2f-2)*********************
(defun c:n1()
(setvar "cmdecho" 0)
(setq ldft(getvar "textsize"))
(setq sizet (getreal (strcat "\n文字大小? <" (rtos ldft 2 2) ">: ")))
(if (= sizetnil)(setq sizet ldft))
(setvar "textsize" sizet)
(prompt "***文字加编号(如:b2f-1 b2f-2 b2f-2)")
(setq i(getint "\n输入起始值<按enter=1>:"))
(if (= i nil)
(setq i 1)
);end if
(setq front(getstring "\n欲加入字串(数字前)<不要加按enter>:"))
(setq ldf(getvar "clayer") )
(if (/= ldf "stext")
(progn(command "layer" "n" "stext" "c" "1" "stext" "" )
(command "layer" "s" "stext" "" ) );end progn
);end if
(setq sp(getpoint "\n点选位置点:"))
(setq stri(strcat front (itoa i) ))
(command "text" sp "" "" stri )
;(command "layer" "n" "cir" "" )
(while (/= sp nil)
(setq i(1+ i))
(setq sp(getpoint "\n点选位置点:"))
(if (/= sp nil)
(progn
(setq stri(strcat front (itoa i) ))
(command "text" sp "" "" stri )
);end progn
);end if
; (command "layer" "s" "cir" "" )
; (command "circle" sp (* 1.3 ldft) )
);end while
(setvar "clayer" ldf )
(prompt "Created by charchin lin 2001 Dec")
(prin1)
)
;****************n1文字加编号(如:b2f-1 b2f-2)*********************
;********************将长度写出成text(ltx)************
(defun c:ltx()
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "area" "e" pause)
(setq v1(rtos(getvar "Perimeter")2 0));取得面积 Perimeter取得周长
(setvar "cmdecho" ce)
(command "text" pause "" "" v1)
);end defun
(prompt "\n(to)将选择text数字加总")
(prompt "\n(areatx) 将长度写出成text")
(prompt "\nCreated by charchin lin 2001 Dec")
;********************将长度写出成text(areatx)************
;********************方向线角度值************
(defun c:cv()
(setvar "cmdecho" 0)
;(getvar a("angdir"));0逆时钟 1顺时钟
(setq spoint(getpoint "\输入起点:"))
(command "line" spoint pause "")
(setq ent(entlast))
(setq ent1(entget ent))
(setq epoint(cdr (assoc 11 ent1)));终点
;(command "aunits" 1); 0十进位 1度分秒 2分度 3弪度 4土地测量位
;(command "auprec" 3);角度小数点位数
;(command "luprec" 3);长度小数点数
;(setq ang(angtos (angle spoint epoint) 1 4));0度 1度分秒 2分度量 3弪度 4测位
(setq angv(angle spoint epoint) );*57.2958279 弪度转角度
(setq dist(rtos (distance spoint epoint) 2 3));1科学 2十进位
;***************角度转换成方位角***********************
(cond
( (and (<= angv 1.5707963)(> angv 0)) (setq ang(angtos (- 1.5707963 angv) 1 4)) );
( (and (<= angv 3.1415926)(> angv 1.5707963)) (setq ang(angtos (- 7.8539816 angv) 1 4)) )
( (and (<= angv 4.7123890)(> angv 3.1415926))(setq ang(angtos (- 7.8539816 angv) 1 4)) )
( (and (<= angv 6.2831853)(> angv 4.7123890))(setq ang(angtos (- 7.8539816 angv) 1 4)) )
( (= angv 0)(setq ang(angtos (- 1.5707963 angv) 1 4)) )
);end cond
(setq ta(*angv57.2958279))
(setq angstr(strcat "Angle=" ang))
(setq distext(strcat "Dist=" dist))
(setq offd(/ (getvar "textsize") 2 ));字离线的最短距离
(setq dh(atan offd (/ (distof dist) 2)));算出角度
(command "style" "romans" "romans" "0" "1" "0" "n" "n" "n")
(setq osnap_v(getvar "osmode")) ;取出osnap值
(setvar "osmode" 0 );并且关闭 以免影响lisp绘图
(command "text" (polar spoint (+ angv dh) (/ (distof dist) 2) ) "" ta distext );文字的位置由dh角度去决定
(command "text" (polar spoint (- angv (* 3 dh)) (/ (distof dist) 2) ) "" ta angstr )
(setvar "osmode" osnap_v );恢复原来抓点模式设定
);end defun
;********************方向线角度值******************
;********************将长度写出成text(qq)加上支数************
(defun c:qq()
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq q(getint "多少支数<enter>"))
(if (= q nil)
(setq q bb)
(progn
(setq q(rtos q))
(setq bb q)
)
)
(command "area" "e" pause)
(setq b1(rtos(getvar "Perimeter")2 0));取得面积 Perimeter取得周?
(setq v1(strcat b1 "x"q ))
(setvar "cmdecho" ce)
(command "text" pause "" "" v1)
);end defun
(prompt "\n(to)将选择text数字加总")
(prompt "\n(areatx) 将长度写出成text")
(prompt "\nCreated by charchin lin 2001 Dec")
;********************将长度写出成text(qq)加上支数************
;(prompt "\nCreated by charchin lin(林志青) 2001 Dec E-MAIL:watts_lin@yahoo.com.tw")
;********************快速bhatch***************
(defun c:bb()
(setq ldfs(getvar "hpspace"))
(setq dd (getdist (strcat "\n剖面间距? <" (rtos ldfs 2 2) ">: ")))
(if (= dd nil) (setq dd ldfs ))
(setq ang (getangle "\n剖面角度<45>:"))
(if (= ang nil) (setq ang (/ pi 4)))
;(initget"Y N")
;(setq dbu (getkword "\n双重剖面Y/N <N>:"))
;(if (= dbu nil) (setq dbu "N"))
(setvar "hpname" "u")
(setvar "hpspace" dd)
(setvar "hpang" ang)
(setvar "hpdouble" 0)
;(if (= (strcase dbu) "Y")
; (setvar "hpdouble" 1)
;(setvar "hpdouble" 0)
; )
(setq pt (getpoint "\n选取内部点:"))
(while (/= pt nil)
(command "-bhatch" pt "")
(setq pt (getpoint "\n选取内部点:"))
);end while
)
;********************快速bhatch***************(defun c:tt(/ ce i data1 textconttotaldec seltext ssn1)
;********************设定字高***************
(defunc:ts(/ texts tsn txt)
(setqtsn(getvar "textsize"))
(setq txt(strcat "\n请输入字高:" "<" (rtos tsn 2 ) ">:" ))
(setq texts(getreal txt) )
(if (= texts nil) (setq texts tsn))
(setvar "textsize" texts)
); end defun
;********************设定字高***************
(defun c:tt(/ ce i data1 textconttotaldec seltext ssn1)
(setq ce(getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq totaltext 0)
(setq seltext "")
(setq ssn1(entsel "\n请选取欲加总文字1(text):"))
(setq i 2)
(redraw (car ssn1) 3);Highlight entity
(while (/= ssn1 nil)
(setq data1(entget (car ssn1)))
(setq textcont(cdr (assoc 1 data1)))
(filterm textcont)
;(setq totaltext(+ totaltext (atof textcont)) )
(setq totaltext(+ totaltext (atof p5)) )
(setq totaldec(rtos totaltext 2 0))
(setq seltext(strcat seltext "+" (rtos (atof p5) 2 0) ))
(setq ssn1(entsel (strcat "\n请选取欲加总文字" (rtos i 2 2) "(text):")))
(if (/= ssn1 nil)
(redraw (car ssn1) 3);Highlight entity
);end if
;(setq ssn1 ssn2)
(setq i(+ i 1))
);end while
(setq result(strcat seltext "=" totaldec))
(command "text" pause "" "" result)
;(princ result)
; (setvar "cmdecho" ce)
(prompt "\nCreated by charchin lin 2001 Dec ***取消高亮度请输入regen***")
);end defun
(defun c:areatx ()
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "area" "e" pause)
(setq v1(rtos(getvar "area")2 0));取得面积 Perimeter取得周长
(setvar "cmdecho" ce)
(command "text" pause "" "" v1)
);end defun
(prompt "\n(to)将选择text数字加总")
(prompt "\n(areatx) 将面积写出成text")
(prompt "\nCreated by charchin lin 2001 Dec")
(defun filterm(data )
(setq p1 "" p2 ""p3 '() p4 "" i 1)
(setq nn (strlen data))
(setq p1 (substr data i 1))
(setq wh "")
(if (= p1 "{") ;A
(progn ;1
(repeat nn;1
(setq p1 (substr data i 1))
(if (= p1 ";" )
(setq q (+ 1 i))
);end if
(setq i (1+ i))
);end repeat 1
(repeat (- nn q ) ;2
(setq p1 (substr data q 1))
(if (/= p1 "}" )
(progn
(setq p2 (strcat p2 p1))
);end progn
);end if
(setq q (1+ q))
);end repeat 2
);progn 1
);end if
(setq p5 p2);
(setq p1 "" p2 ""p3 '() p4 "" i 1 q 1)
(setq p1 (substr data i 1))
(if(/= p1 "{");B
(progn
(repeat nn;1
(setq p1 (substr data i 1))
(if (/= p1 "{") ;11
(if(= p1 "}");e
(setq p1 "")
(setq p2 (strcat p2 p1))
);e
(progn;p
(repeatnn ;d
(setq p1 (substr data q 1))
(if (= p1 ";")
(setq iq )
);
(setq q(1+ q))
);end repeatd
);progn p
);end if 11
(setq i(1+ i))
;(princ p2)
);end repeat 1
(setq p5 p2); 字串变数p5
);progn
(progn
);progn
);end if b
);end defun
干什么用的？
多谢分享，来学习学习
不错的东西。
干什么用的
收了，试试
没简体版的吗，望重新更新一下
汉字那部分，几乎都是乱码
收藏了
谢谢