各位大神帮忙看看，像这个填充lisp要怎么实现呢?

cable2004

是 edata大师的功劳，我只是改改哟。

feng83

试试下面的程序
(defun c:tt (/ os ss sslen en el p01 p02 p03 p04 a1)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (command "_.ucs" "w")
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (vl-load-com)
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if ss
    (progn
      (setq sslen (sslength ss) i 0)
      (while (> sslen i)
        (setq en (ssname ss i))
        (setq el (vlax-ename->vla-object en))
        (vla-getboundingbox el 'p01 'p02)
        (setq p01 (vlax-safearray->list p01)  p02 (vlax-safearray->list p02))
        (setq p03 (list(car p01)(cadr p02)) p04 (list(car p02)(cadr p01)))       
        (entmake-Line p01 (list (+(car p01) 30) (+(cadr p01) 30)))
        (entmake-Line (list (car p01)(+(cadr p01) 30))(list (+(car p01)30)(cadr p01)))       
        (entmake-Line p02 (list (-(car p02) 30) (-(cadr p02) 30)))
        (entmake-Line (list (car p02)(-(cadr p02) 30))(list (-(car p02)30)(cadr p02)))       
        (entmake-Line p03 (list (+(car p03) 30) (-(cadr p03) 30)))
        (entmake-Line (list (car p03) (-(cadr p03)30)) (list (+(car p03) 30) (cadr p03)))       
        (entmake-Line p04 (list (-(car p04) 30) (+(cadr p04) 30)))
        (entmake-Line (list (-(car p04) 30)(cadr p04))(list (car p04)(+(cadr p04) 30)))       
        (command "RECTANG" p01 (list (+(car p01) 30) (+(cadr p01) 30)))(ent_rec)
        (command "RECTANG" p02 (list (-(car p02) 30) (-(cadr p02) 30)))(ent_rec)
        (command "RECTANG" p03 (list (+(car p03) 30) (-(cadr p03) 30)))(ent_rec)
        (command "RECTANG" p04 (list (-(car p04) 30) (+(cadr p04) 30)))(ent_rec)
        (command "RECTANG" (list (+(car p01) 30) (+(cadr p01) 30))(list (-(car p02) 30) (-(cadr p02) 30)))
        (setq a1 (entlast))
        (command "change" a1 "" "p" "c" 138 "")
        (setq i (1+ i)))))
  (setvar "osmode" os)
  (command "undo" "e")
  (setvar "cmdecho" 1))

(defun entmake-Line (p1 p2)
  (entmake (list (cons 0 "LINE") (cons 10 p1)(cons 11 p2)(cons 62 250))))

(defun ent_rec (/ a1)
  (setq a1 (entlast))
  (command "change" a1 "" "p" "c" 8 ""))

llsheng_73

1. (defun c:tt(/ pt p la)
   
2.   (foreach x(sstoes(ssget'((0 . "*polyline")(-4 . ">=")(90 . 4))))
   
3.     (if(>(last(isrectangle(setq pt(optimpl(plinexy x)))))60)
   
4.       (progn
   
5.         (makepl(list(setq la(cdr(assoc 8(entget x)))p(offsetpt pt -30 t))1 0 0 la 138))
   
6.         (mapcar'(lambda(x)(xxxx x(*(sqrt 2)15)(angle(car p)(cadr p))la))(offsetpt pt -15 t))
   
7.         )))
   
8.   (princ))
   
9. (defun SstoEs(ss / a lst)
   
10.   (if(and ss(=(type ss)'pickset))
    
11.     (repeat(setq a(sslength ss))
    
12.     (setq a(1- a)lst(cons(ssname ss a)lst)))))
    
13. (defun makepl(argments);;by Llsheng_73
    
14.   (entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr argments)))
    
15.                   (cons(cons 90(length(car argments)))
    
16.                        (cons(cons 70(if(cadr argments)(cadr argments)0))(mapcar'(lambda(x)(cons 10 x))(car argments)))))))
    
17. (defun xxxx(p r ang la / pt)
    
18.   (makepl(list(setq pt(mapcar'(lambda(x)(polar p(+(* x pi)ang) r))'(0.25 0.75 1.25 1.75)))1 0 0 la 8))
    
19.   (mapcar'(lambda(x y)(makepl(list(list x y)1 0 0 la 250)))(cddr pt)pt))
    
20. (defun plinexy(e / a q m p p1);;by Llsheng_73
    
21.     (setq a(vlax-ename->vla-object e)
    
22.           q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
    
23.           m(if(=(vla-get-objectname a)"AcDb3dPolyline")'(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))
    
24.              '(setq p1(list (car q)(cadr q))q(cddr q))))
    
25.     (while q(eval m)
    
26.       (setq p(if(member p1 p)p(append p(list p1))))))
    
27. (defun Ptoline(pt p1 p2)
    
28.   (trans(mapcar'- pt p1)0(mapcar'- p2 p1)))
    
29. (defun optimpl(pt / a i b c);;by Llsheng_73
    
30.   (setq i 0 a(append(cons(last pt)pt)(list(car pt))))
    
31.   (vl-remove-if'(lambda(x)(setq i(1+ i)b(nth(1- i)a)c(nth(1+ i)a)x(Ptoline x b c)x(and(equal(car x)0 1e-10)(< 0(last x)(distance b c)))))pt))
    
32. (defun Pldir(pts);;by Llsheng_73
    
33.   (<(apply'+(mapcar'(lambda(x y)(-(*(car x)(cadr y))(*(car y)(cadr x))))(cons(car pts)pts)pts))0))
    
34. (defun offsetpt(pt d flag / fx m n pi15 pi2 d1 p1 p0 p q0 q2 q22 q1 q pt1 pt2 ang1 ang2);;by Llsheng_73
    
35.   (setq m(length pt)fx(if flag(PlDir pt))pt(if fx(reverse pt)pt)
    
36.         d1(abs d)
    
37.         pi15(*(if(> d 0)1.5 -1.5)pi)
    
38.         pt2(mapcar'(lambda(y x z)
    
39.                      (if(setq ang1(+(angle y x)pi15)
    
40.                               ang2(+(angle x z)pi15)
    
41.                               q(inters(polar y ang1 d1)(polar x ang1 d1)(polar x ang2 d1)(polar z ang2 d1)nil))
    
42.                        q(polar x ang2 d1)))(append(list(last pt))pt)pt(cdr(append pt(list(car pt)))))
    
43.         pt2(cond((< m 2)pt)
    
44.                     ((= m 2)(list(polar(car pt)ang1 d1)(polar(last pt)ang1 d1)))
    
45.                     (flag pt2)
    
46.                     (t(cons(polar(car pt)(+(angle(car pt)(cadr pt))pi15)d1)
    
47.                               (cdr(reverse(cons(polar(last pt)(+(angle(cadr(reverse pt))(last pt))pi15)d1)(cdr(reverse pt2)))))))))
    
48.   (if fx(reverse pt2)pt2))
    
49. (defun isrectangle(pt);;by Llsheng_73
    
50. (IF(and(=(length pt)4)
    
51.      (equal(apply'-(mapcar'distance(cddr pt)pt))0 1e-10))
    
52.    (vl-sort(mapcar'distance(cdr pt)(cddr pt))'>)))

(defun c:tt(/ pt p la)<br />   (foreach x(sstoes(ssget'((0 . "*polyline")(-4 . ">=")(90 . 4))))<br />     (if(>(last(isrectangle(setq pt(optimpl(plinexy x)))))60)<br />       (progn<br />         (makepl(list(setq la(cdr(assoc 8(entget x)))p(offsetpt pt -30 t))1 0 0 la 138))<br />         (mapcar'(lambda(x)(xxxx x(*(sqrt 2)15)(angle(car p)(cadr p))la))(offsetpt pt -15 t))<br />         )))<br />   (princ))<br /> (defun SstoEs(ss / a lst)<br />   (if(and ss(=(type ss)'pickset))<br />     (repeat(setq a(sslength ss))<br />     (setq a(1- a)lst(cons(ssname ss a)lst)))))<br /> (defun makepl(argments);;by Llsheng_73<br />   (entmakex(append(mapcar'cons'(0 100 100 43 370 8 62 39 6)(append'("LWPOLYLINE""AcDbEntity""AcDbPolyline")(cddr argments)))<br />                   (cons(cons 90(length(car argments)))<br />                        (cons(cons 70(if(cadr argments)(cadr argments)0))(mapcar'(lambda(x)(cons 10 x))(car argments)))))))<br /> (defun xxxx(p r ang la / pt)<br />   (makepl(list(setq pt(mapcar'(lambda(x)(polar p(+(* x pi)ang) r))'(0.25 0.75 1.25 1.75)))1 0 0 la 8))<br />   (mapcar'(lambda(x y)(makepl(list(list x y)1 0 0 la 250)))(cddr pt)pt))<br /> (defun plinexy(e / a q m p p1);;by Llsheng_73<br />     (setq a(vlax-ename->vla-object e)<br />           q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))<br />           m(if(=(vla-get-objectname a)"AcDb3dPolyline")'(setq p1(list (car q)(cadr q)(caddr q))q(cdddr q))<br />              '(setq p1(list (car q)(cadr q))q(cddr q))))<br />     (while q(eval m)<br />       (setq p(if(member p1 p)p(append p(list p1))))))<br /> (defun Ptoline(pt p1 p2)<br />   (trans(mapcar'- pt p1)0(mapcar'- p2 p1)))<br /> (defun optimpl(pt / a i b c);;by Llsheng_73<br />   (setq i 0 a(append(cons(last pt)pt)(list(car pt))))<br />   (vl-remove-if'(lambda(x)(setq i(1+ i)b(nth(1- i)a)c(nth(1+ i)a)x(Ptoline x b c)x(and(equal(car x)0 1e-10)(< 0(last x)(distance b c)))))pt))<br /> (defun Pldir(pts);;by Llsheng_73<br />   (<(apply'+(mapcar'(lambda(x y)(-(*(car x)(cadr y))(*(car y)(cadr x))))(cons(car pts)pts)pts))0))<br /> (defun offsetpt(pt d flag / fx m n pi15 pi2 d1 p1 p0 p q0 q2 q22 q1 q pt1 pt2 ang1 ang2);;by Llsheng_73 <br />   (setq m(length pt)fx(if flag(PlDir pt))pt(if fx(reverse pt)pt)<br />         d1(abs d)<br />         pi15(*(if(> d 0)1.5 -1.5)pi)<br />         pt2(mapcar'(lambda(y x z)<br />                      (if(setq ang1(+(angle y x)pi15)<br />                               ang2(+(angle x z)pi15)<br />                               q(inters(polar y ang1 d1)(polar x ang1 d1)(polar x ang2 d1)(polar z ang2 d1)nil))<br />                        q(polar x ang2 d1)))(append(list(last pt))pt)pt(cdr(append pt(list(car pt)))))<br />         pt2(cond((< m 2)pt)<br />                     ((= m 2)(list(polar(car pt)ang1 d1)(polar(last pt)ang1 d1)))<br />                     (flag pt2)<br />                     (t(cons(polar(car pt)(+(angle(car pt)(cadr pt))pi15)d1)<br />                               (cdr(reverse(cons(polar(last pt)(+(angle(cadr(reverse pt))(last pt))pi15)d1)(cdr(reverse pt2)))))))))<br />   (if fx(reverse pt2)pt2))<br /> (defun isrectangle(pt);;by Llsheng_73<br /> (IF(and(=(length pt)4)<br />      (equal(apply'-(mapcar'distance(cddr pt)pt))0 1e-10))<br />    (vl-sort(mapcar'distance(cdr pt)(cddr pt))'>)))