偏爱云~小吴 发表于 2013-12-10 22:21 - (defun new_ss (elast / ss1 ss2 ee2 i loop)
- (setq ss2 (ssget "x"))
- (setq i 0 loop t ss1 (ssadd))
- (while loop
- (setq ee2 (ssname ss2 i) i (1+ i))
- (if (not (eq ee2 elast))
- (if (/= (cdr (assoc 0 (entget ee2))) "VIEWPORT")
- (setq ss1 (ssadd ee2 ss1))
- )
- (setq loop nil)
- )
- )
- ss1
- )
- (defun xgzm (ss lst / ent i x)
- (repeat (setq i (sslength ss))
- (setq ent (entget (ssname ss (setq i (1- i)))))
- (mapcar '(lambda(x) (setq ent (entmod (subst x (assoc (car x) ent) ent)))) lst)
- )
- )
- (defun c:tt ( / bn box ea i of p0 p10 p11 sl ssk ssl ssn xb xd yb yd)
- (command "undo" "be")
- (setq box (acet-geom-ss-extents (ssget '((0 . "line"))) t)
- xd (- (caadr box) (caar box))
- yd (- (cadadr box) (cadar box))
- p0 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
- of (getdist "\n偏移值<或图面量取>:")
- bn (cdr (assoc 2 (entget (car (entsel "\n选取要插入的图块:")))))
- xb (/ (- xd (* 2 of)) 100)
- yb (/ (- yd (* 2 of)) 80)
- ea (entlast)
- )
- (command "INSERT" bn p0 xb yb "0")
- (command "explode" (entlast))
- (setq ssn (new_ss ea)
- ssk (ssget "p" '((0 . "INSERT")))
- )
- (command "select" ssn "r" ssk "")
- (setq ssl (ssget "p"))
- (xgzm ssk (list (cons 41 1) (cons 42 1) (cons 43 1)))
- (setq i -1)
- (while (setq sl (ssname ssl (setq i (1+ i))))
- (setq p10 (cdr (assoc 10 (entget sl)))
- p11 (cdr (assoc 11 (entget sl)))
- )
- (command "LENGTHEN" "de" of (list sl p10) (list sl p11) "")
- )
- (command "undo" "e")
- )
|