一定范围内的文字合并程序,请高手帮看一下错在那?
(defun C:HBWZ()(setq ss1 (ssget '((0 . "TEXT"))) )
( setq r (getreal "\半径 r "))
(setvar "cmdecho" 0)
(setq m (sslength ss1))
(setq indes 0)
(repeat m
(setq entname (ssname ss1 indes)
ent3 (entget entname))
(setq indes (1+ indes))
(setq tt1 (cdr(assoc 1 ent3)))
(if (/= (substr tt1 1 1) "(")
(progn
(setq la(car (get-textbox entname) )
la2 (car (cdddr (get-textbox entname))))
(setq ss2 (ssdel entname ss1))
(setq n (sslength ss2))
(setq indes1 0)
(repeat n
(setq entname1 (ssname ss2 indes1)
ent1 (entget entname1))
(setq indes1 (+ 1 indes1))
(setq tt2 (cdr (assoc 1 ent1))
la1 (cdr (assoc 10 ent1)) )
(setq la1(car (get-textbox entname1) )
la3 (car (cddr (get-textbox entname1))))
(if (or (< (distance la la1) r)(< (distance la la3) r)(< (distance la2 la1) r)(< (distance la2 la3) r) )
(progn
(setq tt2 (strcat tt1 tt2))
(subst '(1 . tt2) (assoc 1 ent3) ent3)
)
))repeat end
)
)
)repeat end
)
(defun get-textbox ( EN /ang-self ang en ent pt0-ll pt0-tr pt-ins pt-2 pt-3 pt-4 pt-list x y )
(setq ent (entget en))
(setq pt-ins (cdr (assoc 10 ent)))
(setq ang (cdr (assoc 50 ent)))
(setq pt-list (textbox ent))
(setq pt0-ll (car pt-list))
(setq pt0-tr (cadr pt-list))
(setq box-tr (mapcar '(lambda (x y) (+ x y)) pt0-ll pt0-tr))
(setqbox-length (car box-tr))
(setqbox-height (cadr box-tr))
(setq ang-self (atan (cadr box-tr) (car box-tr)))
(setq dis(distance '(0.0 0.0 0.0) box-tr))
(setq pt-3 (polar pt-ins (+ ang-self ang) dis))
(setq pt-2 (polar pt-insang box-length))
(setq pt-4 (polar pt-ins (+ ang (*0.5 pi) ) box-height))
(list pt-ins pt-2 pt-3 pt-4)
)
提问也需要讲清楚要达到什么目的,你的程序是怎么考虑的。
只是代码,没人有功夫和心情研究。都不知道在看什么。
页:
[1]