(defun C:tt1 (/ EN ENT LST LST1 OLDAUN OLDOSM PT SS i ptlst ss1 STR TXT ZG)
(setq oldaun (getvar "aunits")
oldosm (getvar "osmode"))
(setvar "aunits" 3) ;设为弧度
(setvar "osmode" 0 ) ;设为无捕捉方式
;选择封闭方框
(if(setq ss(ssget '((0 . "LWPOLYLINE")(90 . 5)(70 . 0)))
请高手指正为什么不能实现批量 http://bbs.mjtd.com/thread-108271-2-1.html
已经回复了！ (defun tt (ss / EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
(setq oldaun (getvar "aunits")
oldosm (getvar "osmode"))
(setvar "aunits" 3) ;设为弧度
(setvar "osmode" 0 ) ;设为无捕捉方式
(if (not ss) ;图中没有插入各种符号
(progn (alert " 没有选中文本")
(exit))
(progn
(while (> (sslength ss) 0)
(setq ent (entget(setq en (ssname ss 0))));取出第一个数据
(setq pt (cdr(assoc 10 ent))
txt (cdr(assoc 1 ent))
zg (cdr(assoc 40 ent))
lst (cons (list pt txt zg) lst);;获取表
ss (ssdel en ss))
(entdelen));删除图元
(setq lst1 (vl-sort lst
(function (lambda (e1 e2)
(< (cadr(car e1)) (cadr(car e2))) ) ) ));根据y坐标排序
(setq str "")
(foreach e lst1
(setq str (strcat (cadr e) "\n" str))
(setq pt (car e);插入点
zg (caddr e)));字高
(setq pt (polar pt (* pi 0.5) zg))
(vl-cmdf "MTEXT" pt "H" zg "W" 0 (substr str 1 (1- (strlen str))) "")))
(setvar "aunits" oldaun) ;设为弧度
(setvar "osmode" oldosm )
(princ)
)
(defun ss2lst (ss / lst n ssnamen)
(setq n -1
lst '()
)
(while (setq ssnamen (ssname ss (setq n (1+ n))))
(setq lst (cons ssnamen lst))
)
(reverse lst)
)
(defun c:t0 ( / lst p1 p2 pn s1 ss ss0)
(vl-load-com)
(setq ss (ssget '((0 . "LWPOLYLINE")))
lst (ss2lst ss)
)
(foreach s1 lst
(setq pn (vlax-get (vlax-ename->vla-object s1) 'coordinates)
p1 (list (nth 0 pn) (nth 1 pn))
p2 (list (nth 4 pn) (nth 5 pn))
ss0 (ssget "c" p1 p2 '((0 . "*TEXT")))
)
(tt ss0)
)
) 感谢大神，圆满解决 感谢！我找了好久呢！
页:
1
[2]