lisp visual 开根号_自动编号问题 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

(defun c:tt(/ ss font_height1 n k po na)

(or font_height (setq font_height 100))

(if(setq font_height1(getdist (strcat "\n输入文字高度:")))

(setq font_height font_height1))

(if(and (setq ss (ssget (list '(0 . "LWPOLYLINE"))))

)

(progn

(setq n 0 k 1)

(repeat (sslength ss)

(setq na (ssname ss n))

(setq po (Get_center_relative na))

(entmake (list '(0 . "MTEXT")

'(100 . "AcDbEntity")

'(100 . "AcDbMText")

(cons 7(getvar 'TEXTSTYLE))

(cons 1 (rtos k 2 0))

(cons 10 po)

(cons 40 font_height)

(cons 71 5)

)

)

;(command "text" "j" "mc" "non" po font_height 0 k "")

(setq k (1+ k))

(setq n (1+ n))

)

)

)

(princ)

)

(defun Get_center_relative (ename /  Pts   2R Mk   Mkline  points   DelLine   Tssred

i   lst  N  Newlst    DistList     R   Number  Tssbak TssSub  Pt)

(setq Obj     (Vlax-Ename->Vla-Object ename)

Tssbak  (Vlax-Get Obj 'Thickness )

TssSub  (Vlax-Put Obj 'Thickness 0 ))

(setq Pts     (GetBoundingBox ename)

2R      (MJ:MIDPOINT (CAR Pts) (CADR Pts))

Mk      (entmake (list (cons 0 "LINE")(cons 8 "JMDSS")(cons 10 (polar 2R 0.0 1000))(cons 11 (polar 2R 3.14159 1000))))

Mkline  (entlast)

points  (vlax-invoke (vlax-ename->vla-object ename) 'IntersectWith (vlax-ename->vla-object Mkline) acExtendOtherEntity)

Tssred  (Vlax-Put Obj 'Thickness (eval Tssbak) )

DelLine (entdel Mkline)

i       0

lst     nil

)

(repeat (/ (length points) 3)

(setq lst (append lst (list (list (nth i points) (nth (1+ i) points) (nth (+ 2 i) points)))))

(setq i (+ i 3))

)

(setq lst (px lst))

(if (>= (length lst) 4)

(progn

(setq N      0

Newlst nil)

(repeat (/ (length lst) 2)

(setq Newlst (append Newlst (list (list (nth N lst) (nth (1+ N) lst)))))

(setq N (+ 2 N))

)

(setq DistList nil

R        0)

(repeat (length Newlst)

(setq Number (nth R Newlst)

DistList (append DistList  (list(distance (car Number) (cadr Number)))))

(setq R (1+ R))

)

(setq  Pt (nth (vl-position (car (vl-sort DistList '>)) DistList) Newlst))

(MJ:MIDPOINT (car pt) (cadr pt));返回值

)

(MJ:MIDPOINT (car lst) (cadr lst));返回值

)

)

(defun MJ:MIDPOINT (P1 P2)

(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)

)

(defun GetBoundingBox (ent / ll ur)

(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)

(mapcar 'vlax-safearray->list (list ll ur))

)

(defun px (X)

(vl-sort  X

(function (lambda (e1 e2)

(< (car e1) (car e2)) ) ) )

)