;;-----------------------------------------------------------------------------
;;;改字母大小写
(defun c:test003 ()
(CMDLA0)
(setq dx (UKWORD 1 "1 2" "修改方式: 1-大写/2-小写" dx))
(prompt "\n请选择要改变的字符串: ")
(setq ss (ssget '((0 . "TEXT")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq tx (xyp-get-DXF 1 s1))
(if (= dx "1")
(setq tx (strcase tx))
(setq tx (strcase tx T))
)
(xyp-SubUpd s1 1 tx)
)
(CMDLA1)
)

;;-----------------------------------------------------------------------------
;;;批量炸碎文字变成线
(Defun c:test004 ()
(CMDLA0)
(SetVar "MIRRTEXT" 1)
(setvar "osmode" 0)
(PrinC "\n选择要分解的文字: ")
(setq ss (ssget '((0 . "TEXT")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt1 (xyp-get-MinMaxPoint s1 1)
pt2 (xyp-get-MinMaxPoint s1 9)
pt (xyp-get-MidPoint pt1 pt2)
pt3 (polar pt (* pi 0.5) 100)
)
(Command "mirror" s1 "" pt pt3 "y")
(command "zoom" "w" pt1 pt2)
(command "wmfout" "TEXTWMF" s1 "" "erase" s1 "")
(command "wmfin" "TEXTWMF" pt "2" "" "")
(setq s1 (EntLast))
(command "mirror" s1 "" pt pt3 "y")
(setq pt0 (xyp-get-MidPoint
(xyp-get-MinMaxPoint s1 1)
(xyp-get-MinMaxPoint s1 9)
)
)
(xyp-move s1 pt0 pt)
(command "explode" s1 "")
)
(setvar "MIRRTEXT" 0)
(CMDLA1)
)

;;-----------------------------------------------------------------------------
;;;字按线对齐
(defun C:test005 (/ lst n ent txt objtype errhandler olderr elst lst1)
(CMDLA0)
(setq *Nblock* 0)
(defun errhandler (s)
(if (/= s "Function cancelled")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "\nError: " s))
)
)
(xyp-erase ent)
(command "_.undo" "end")
)
(command "_.undo" "begin")

(setvar "cmdecho" 0)
(setvar "errno" 7)
(while (= (getvar "errno") 7)
(setq lst (entsel "\n选择 [线Line Or 弧Arc]: "))
(if lst
(progn
(setq lst1 (GetNestEntity lst)
n (last lst1)
ent (car lst1)
elst (entget ent)
objtype (cdr (assoc 0 elst))
*Nblock* 0
)
(if (> n 0)
(command "_.undo" n)
)
(entmake elst)
(setq ent (entlast))
(if (or (wcmatch objtype "LINE")
(wcmatch objtype "ARC")
)
(progn
(redraw ent 3)
(setvar "errno" 7)
(while (= (getvar "errno") 7)
(setq txt (entsel "\nSelect text: "))
(if txt
(progn
(setq txt (car txt))
(if (wcmatch (cdr (assoc 0 (entget txt))) "TEXT")
(progn
(cond
((wcmatch (cdr (assoc 0 (entget ent))) "LINE")
(TextAlignToLine ent txt)
)
((wcmatch (cdr (assoc 0 (entget ent))) "ARC")
(TextAlignToArc ent txt)
)
((wcmatch (cdr (assoc 0 (entget ent))) "CIRCLE")
(alert "You pick a Circle")
)
)
)
)
)
)
)
(setvar "errno" 0)
(entdel ent)
)
(progn
(xyp-erase ent)
(setvar "errno" 7)
)
)
)
)
)
(command "_.undo" "end")
(CMDLA1)
)
(defun TextAlignToLine (Line Text / LineTable
PointStart PointEnd LineAngle TextTable
)
(setq LineTable (entget Line)
PointStart (cdr (assoc '10 LineTable))
PointEnd (cdr (assoc '11 LineTable))
LineAngle (angle PointStart PointEnd)
)
(if (or (> (* pi 1.5) LineAngle (* pi 0.5))
(= LineAngle (* pi 1.5))
)
(setq LineAngle (- LineAngle pi))
)
(setq TextTable (entget Text)
TextTable (subst (cons '50 LineAngle)
(assoc '50 TextTable)
TextTable
)
)
(entmod TextTable)
(setvar "errno" 7)
)
(defun TextAlignToArc (Arc Text / ArcTable Centerpoint TextTable TextBpt ang)
(setq ArcTable (entget Arc)
Centerpoint (cdr (assoc 10 ArcTable))
TextTable (entget Text)
TextBpt (cdr (assoc 10 TextTable))
ang (+ (angle Centerpoint TextBpt) (/ pi 2))
)
(if (or (> (* pi 1.5) ang (* pi 0.5)) (= ang (* pi 1.5)))
(setq ang (- ang pi))
)
(setq
TextTable (subst (cons '50 ang) (assoc '50 TextTable) TextTable)
)
(entmod TextTable)
(setvar "errno" 7)
)

(defun GetNestEntity (ELst / ent1 ss1 pt lst lst1 Obj lst2)
(setq ent1 (car ELst)
pt (cadr ELst)
lst1 (entget ent1)
Obj (cdr (assoc 0 lst1))
ss1 nil
)
(if (or (wcmatch Obj "INSERT")
(wcmatch Obj "LWPOLYLINE")
(wcmatch Obj "POLYLINE")
)
(progn
(command "_.explode" ent1 "")
(setq *Nblock* (1+ *Nblock*))
(if (setq ss1 (ssget pt))
(setq lst2 (list (ssname ss1 0) pt)
lst (GetNestEntity lst2)
)
(progn
(command "_.undo" *Nblock*)
(setq *Nblock* 0)
(exit)
)
)
(list (car lst) (1+ (cadr lst)))
)
(list ent1 0)
)
)

;;-----------------------------------------------------------------------------
;;;面积求和
(defun c:test006 ()
(cmdla0)
(if (setq ss1 (ssget '((0 . "*LINE,CIRCLE,ELLIPSE,REGION"))))
(progn
(setq nr 0
tot_area 0.0
en (ssname ss1 nr)
)
(while en
(command "._area" "_O" en)
(setq tot_area (+ tot_area (getvar "area"))
nr (1+ nr)
en (ssname ss1 nr)
)
)
(princ "\n面积之和 = ")
(princ (rtos tot_area 2 3))
)
)
(cmdla1)
)

;;-----------------------------------------------------------------------------
;;;打断插文字
(defun c:test007 (/ r h1 h2 na)
(CMDLA0)
(setq th (UDIST 1 "" "新文字高度" th (list 0 0))
r (* th 1.25)
tx (USTR 1 "请输入要插入的文字" tx nil)
)
(while (setq h1 (entsel))
(setq h2 (cadr h1))
(command "circle" h2 r)
(setq na (entlast))
(command "trim" na "" h1 "")
(command "text" "J" "M" h2 th "" tx)
(xyp-erase na)
)
(CMDLA1)
)

;;-----------------------------------------------------------------------------
;;;改多圆、圆弧半径
(defun c:test008 ()
(setq ss (ssget '((0 . "CIRCLE,ARC")))
rad (UREAL 7 "" "新半径" rad)
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-SubUpd s1 40 rad)
)
(princ)
)

;; 天圆地方
(defun c:test889 ()
(CMDLA0)
(setq s1 (XYP-ADD-ELLIPSE '(0 0 12000) 3000 2000) ;(xyp-add-circle '(0 0 5000) 1000)
s2
(xyp-Entmake-lwPolyline
'((-1500 1500) (-1500 0) (-1500 -1500) (1500 -1500) (1500 0) (1500 1500))
t
)
ptn1 (xyp-get-CurveDivNumPtlst s1 72)
ptn1 (mapcar '(lambda (x) (list (car x) (cadr x) (+ (abs (cadr x)) (caddr x)))) ptn1)
ptn2 (xyp-get-CurveDivNumPtlst s2 72)
ptn '()
i 0
)
(entdel s1)
(entdel s2)
(xyp-MkLaCo "TEST2" 2)
(foreach p1 ptn1
(setq p2 (nth i ptn2)
i (1+ i)
s3 (xyp-add-line p1 p2)
ptn3 (xyp-get-CurveDivNumPtlst s3 72)
ptn (cons ptn3 ptn)
)
(XYP-EXTRUDE-BOX s3 40 40 0)
(entdel s3)
)
(xyp-MkLaCo "TEST4" 4)
(XYP-3D-MESHWITHPTNS PTN)
(CMDLA1)
)

支持一下，谢谢楼主