日志
把常用的几个单行文本程序放到一起
热度 2 |||
;输入整数手工修改单行文本开头的数字
(defun c:tt()
(while(setq stn(car(entsel)))
(setq num (getint"输入整数")
stnn (entget stn)
contt(cdr(assoc 1 stnn))
numcontt (strcat (itoa num)
(vl-string-left-trim " 0123456789" contt)
)
)
(entmod (subst (cons 1 numcontt)
(assoc 1 stnn)
stnn
)
)
)
)
;批量递增单行文本开头的数字 参考大神程序改编
(defun c:ttt()
(setq sz (getint"输入起始整数: ")
szdz (getint"输入递增整数: ")
stn (ssget (list(cons 0 "*text")))
stnl (sslength stn)
n 0
reclist nil
)
(if (null szdz)(setq szdz 1)) ;不输入递增数默认为1
(if (null sz)(setq sz 1)) ;不输入起始数默认为1
(repeat stnl
(setq Stnm(ssname stn n)
inspnt(cdr(assoc 10 (entget stnm)))
reclist(cons (list (cadr inspnt) stnm) reclist)
)
(setq n(1+ n))
)
;Y排序
;(vl-sort reclist '(lambda(e1 e2)(<(cadr(car e1))(cadr(car e2)) )))
(setq reclist(vl_sort reclist '(lambda(e1 e2)(<(car e1)(car e2)) )))
;递增
(setq n 0)
(foreach stna reclist
(setq stnm (cadr stna)
stnn (entget stnm)
contt (cdr(assoc 1 stnn))
szct (strcat (itoa sz)
(vl-string-left-trim " 0123456789" contt)
)
)
(entmod (subst (cons 1 szct)
(assoc 1 stnn)
stnn
)
);更新
(setq n(1+ n) sz(+ szdz sz))
)
)
;批量等行间距排列文字 大神作者的源程序
(defun c:tttt(/ i zuob dss ess ls lsn sswz sswzd ss1 oldmodA)
(setvar "cmdecho" 0)
(princ "\n 选择文字:")
(setq ss1 (ssget '((0 . "text,insert"))))
(if ss1 (progn
(setq i 0 sswz '() ssn (sslength ss1))
(repeat ssn
(setq zuob (cdr (assoc 10 (entget (ssname ss1 i))))
sswz (cons (list (ssname ss1 i) zuob) sswz)
i (1+ i)
)
)
(setq sswzd (vl_sort sswz '(lambda (e1 e2)(< (cadr (cadr e1)) (cadr(cadr e2)))))
Ls (abs (- (cadr (cadr (nth (- ssn 1) sswzd)))
(cadr (cadr (car sswzd)))
)
)
Lsn (/ ls (- ssn 1))
i 0 ;;行高
dss (cadr (cadr (nth i sswzd)))
ess (car (cadr (nth i sswzd)))
)
(setq stlsn(getdist (strcat "\n 请输入一个数值或在屏幕上取一段距离 <" (rtos lsn 2) ">:")))
(if stlsn (setq lsn stlsn));行if
(command "undo" "be")
(setq oldmodA (getvar "osmode"))
(setvar "osmode" 0)
(repeat (- ssn 1)
(setq i (1+ i))
(command "move"
(car (nth i sswzd))
""
(cadr (nth i sswzd))
(strcat (rtos ess 2 5)
","
(rtos (+ dss (* i lsn)) 2 5)
);str
);com
);re
(setvar "osmode" oldmodA)
(princ (strcat "共排列 " (itoa ssn) " 行文字") )
(command "undo" "e")
) ;ifpro
(princ "\n 未选择对象")
) ;if
(princ)
)
;排序 大神作者?的源程序
;加了注解，但把我搅糊涂了，数学不行只知道是"比较大小按顺序放"这个意思。
;学习到用eval函数可以对AutoLISP表达式求值,,简化了代码量。
(defun vl_sort (lst fun / k nlst lst2)
(foreach n lst
(setq k T
lst2 (apply
'append ;;组合map表,
(mapcar
'(lambda (x)
(if (and K ;如果预设条件K为真, 变体表(list 真或假 变体n 变体x )为真
((eval fun) n x) ;(< 1 2)=t (< 3 2)=nil
);and
(progn ;以上and条件为真时 (and t nil )? ,把预设条件K改为假,有变体表 (list 变体n 变体x)
(setq k nil)
(list n x) ;有变体表 (list 变体n 变体 x)
) ;ifpro
(list x) ;;以上and条件都为假时,有变体表 (list x)
) ;if
) ;fun
nlst ;组合后的新表,变体lst2初值无
;假设数字 lst '( 5 3 4 2 1 6 )
;5-nil 3-5 4-3,5 2-5 ,3, 4 ... ; ( 5) (3 5 ) (3 4) ,(4 5) ...
;
);map
);apply
nlst (if K ;如果预设条件K为真,画表 (list 变体n)并与lst2组合成一个新表nlst
; K为假 lst2变体赋值到nlst变体 lst2变体初值为无
(append lst2 (list n))
lst2
);if
);setq
);for
)
;;;================================================================
;;;功能：合并多个单行文字 大神作者ZML的源程序
;;;
;;;================================================================
(defun c:t2t ()
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
;;
(setq lst_str '()
i 0
)
(repeat (sslength ss)
(setq en (ssname ss i)
ent (entget en)
str (cdr (assoc 1 ent))
lst_str (cons str lst_str)
)
(if (= i 0) ()(entdel en))
(setq i (1+ i))
)
;;
(setq en (ssname ss 0)
ent (entget en)
str (apply 'strcat (reverse lst_str))
ent (subst (cons 1 str )(assoc 1 ent) ent)
)
(entmod ent)
)
)
(princ)
)
;;;================================================================
(princ)
(vl-load-com)
;断开单行文字 大神作者?的源程序
(defun c:ttttt( / ent textsel basepoint pickpoint str mipt mapt widofstr singletextwid picknumber fstr bstr newtext inpoint)
(setq acaddocument(vla-get-activedocument(vlax-get-acad-object)))
(vla-StartUndoMark acaddocument)
(setq ent(entsel "\n选择要截断换行的位置："))
(if (/= ent NIL)
(command "_.SELECT" (car ent) "")
(alert "该位置没有文字对象!")
)
(if (setq textsel(ssget "p" '((0 . "text"))))
(progn;已经是点在单行文字上面--------------------------------------------
(setq textsel(car(tc:sel->list textsel)));转换为选择对象的列表---------
(setq baseipoint(vlax-get textsel 'InsertionPoint);文字的起点----------
pickpoint(cadr ent) ;鼠标点选的点--------
str(vla-get-textstring textsel) ;获得文字的内容------
angel(vla-get-rotation textsel) ;获得文字的旋转角度--
height(vlax-get textsel 'height) ;获得文字的高度------
textaligpo(vlax-get textsel 'textalignmentpoint);获得对齐点------
alignment(vlax-get textsel 'alignment) ;获得文字的对齐属性--
)
(if (= 0 alignment)(setq textaligpo baseipoint))
(vla-GetBoundingBox textsel 'mipt 'mapt)
;(vla-addline (vla-get-modelspace acaddocument) mipt mapt)
(setq mipt(vlax-safearray->list mipt))
(setq mapt(vlax-safearray->list mapt));获得文字的外框以便计算----------
;下面进行字符串的改造第一个表元素是字符串的长度,其他分别是每个字符-----
;例如:(tc:getstrwid "我在马路边123~")
;返回(9 "我" "在" "马" "路" "边" "1" "2" "3" "~")
(setq widofstr(tc:getstrwid str));获得字符串的实际长度,中文每个为一个--
;下面获得单个的文本的宽度----------------------------------------------
(setq tmplen(distance mapt mipt))
(setq tmpwid(- (car mapt) (car mipt)))
(setq ang(atan (/ (sqrt (- (expt tmplen 2)(expt tmpwid 2))) tmpwid)))
(setq ang(- ang angel))
(setq textwid(* tmplen (cos ang)));以上增加了角度计算,,,是几何算法-----
(setq singletextwid(/ textwid (car widofstr)));获得单个文本的宽度------
(setq tmplen(distance baseipoint pickpoint))
(setq tmpwid(- (car pickpoint) (car baseipoint)))
(setq ang(atan (/ (sqrt (- (expt tmplen 2)(expt tmpwid 2))) tmpwid)))
(setq ang(- ang angel))
(setq picknumber(fix(/ (* tmplen (cos ang)) singletextwid)))
(if (> picknumber 0);如果不是选择在第一个文字范围内就分割字符串--------
(progn
(setq m 0)
(while (<= (setq m(1+ m)) picknumber)
(if (null fstr)
(setq fstr (nth m widofstr))
(setq fstr(strcat fstr (nth m widofstr)))
)
);得到前面的字符串---------------------------------------------------------------
(while (< (setq picknumber(1+ picknumber))(length widofstr))
(if (null bstr)
(setq bstr (nth picknumber widofstr))
(setq bstr(strcat bstr (nth picknumber widofstr)))
)
);上面已经分割出两个字符串fstr和bstr了-------------------------------------------
(vla-put-textstring textsel fstr)
;计算截断后的文本的插入点--------------------------------------------------------
(setq inpoint(polar textaligpo (+ (* pi (/ 270.0 180.0)) angel) (* 1.3 height)))
;默认为下移原来行高的1.3倍-------------------------------------------------------
(setq newtext(vla-copy textsel));采用复制再移动以达到同样的文字样式的效果--------
(vla-move newtext (vlax-3d-point textaligpo) (vlax-3d-point inpoint))
(vla-put-textstring newtext bstr)
)
);完成-----------------------------------------------------------------
)
)
(vla-endUndoMark acaddocument)
(princ)
)
;子程序,把选择集合转换成选择集表---------------------------------------------
(defun tc:sel->list(objsel / m objsellist)
(setq m -1)
(while (< (setq m(+ m 1)) (sslength objsel))
(setq objsellist(cons (vlax-ename->vla-object (ssname objsel m)) objsellist)))
)
;计算字符串的长度并分解为表-----中文字每个字为一个长度------------------
(defun tc:getstrwid(str / m n a c)
(setq m 0)
(setq n 0)
(while (< m (strlen str))
(if (> (vl-string-elt str m) 128)
(progn
(setq n(1+ n))
(setq a (substr str (1+ m) 2))
(setq m(+ 2 m))
)
(progn
(setq n(1+ n))
(setq a (substr str (1+ m) 1))
(setq m(1+ m))
)
)
(setq c(cons a c))
)
(setq c(reverse c))
(cons n c)
)
已同步至 crazylsp的微博
