【源码】偶然得到的动态块自动填充源码 求大神优化

秋画扇

偶然得到的源码,功能如下
快捷键CKK是单个插入
快捷键CKKK是批量插入但是只能选矩形插入
动态块要求：高度参数命名为E1和宽度参数命名为E2，基点需要在左下角，E3为判断语句，E1大于1750，E3=960；E1小于等于1750，E3=90
选择模型后右键可镜像切换 需要有翻转参数 "翻转状态1"位置居中

有几个地方求大神优化
1:动态块基点能否改到左上角
2:含有定义属性的动态块,自动填充后,属性不显示 不知道能否解决
3:增加框选填充功能,并可选自动填充方式

非必要项目
1:增加上下翻转
2:批量识别不限定矩形
3:动态块只有E2或只有E1时，可以正常填充




        (defun c:ckk( / dxert en enb fz name2 pt1 )  
                (defun dongtai( enb enb2 fz dxert  / a code data dx_actdyn elist gr j ja jj loop name1 name8 pt )  
                (PRINC "\n选择图形放置的区域或回车结束***动态按模板单个插入动态块执行完成***Design By---浩浩 2021-1-24******转载请注明出处*******" )
                 (if enb (progn   (setq elist (entget enb )) (setq loop t)  (while (and loop  ) (setq gr (grread t 15 0 ))
                 (setq code (car gr )) (setq data (cadr gr )) (cond ((= code 5 ) (entmod (subst (cons 10 data ) (assoc 10 elist ) elist ) ) )
                 ((= code 3 ) (setq name8 (huazuixiaojuxing data )) (setq name1 (haohaoxuanjuxing data )) (setq jj 960) (setq ja 90)
                 (setq pt (xyp-9pt name1 1 )) (entmake (list '(0 . "INSERT") (cons 2 enb2 ) (cons 10 pt ) ) )
                 (setq dx_actdyn (vlax-ename->vla-object (entlast ) ))
                 (setq j (- (cadr (xyp-9pt name1 7 ) ) (cadr pt ) ))
                 (setq a (- (car (xyp-9pt name1 3 ) ) (car pt ) ))
                 (lm:setdynpropvalue dx_actdyn "E1" j ) (lm:setdynpropvalue dx_actdyn "E2" a )
                 (if (> j 1750 ) (progn   (lm:setdynpropvalue dx_actdyn "E3" jj ) )(progn   
                 (lm:setdynpropvalue dx_actdyn "E3" ja ) )) (lm:setdynpropvalue dx_actdyn "翻转状态1" fz ) (entdel name8 ) )
                 ((member code '(11 25 ) )  (if fz (progn    (if (= fz 0 ) (progn   (setq fz 1) (lm:setdynpropvalue dxert "翻转状态1" fz ) )
                 (progn   (setq fz 0) (lm:setdynpropvalue dxert "翻转状态1" fz ) )) )) (dongtai enb enb2 fz dxert ) ) ((= code 2 ) (setq loop nil)
                 (ENTDEL ENB ) (PRINC "\n***动态按模板单个插入动态块执行完成***Design By---浩浩 2021-1-24******转载请注明出处*******" ) (quit ) ) ) ) ))  )
                 (setq en (car (xentsel "\n请选择一个模板动态块:" '((0 . "insert") ) ) )) (setq pt1 '(0 0 )) (setq name2 (get-effectivename en ))
                 (entmake (list '(0 . "INSERT") (cons 2 name2 ) (cons 10 pt1 ) ) ) (setq enb (entlast )) (setq dxert (vlax-ename->vla-object enb ))
                 (setq fz (lm:getdynpropvalue dxert "翻转状态1" )) (dongtai enb name2 fz dxert )
                 (princ "\n***动态按模板单个插入动态块执行完成***Design By---浩浩 2021-1-24******转载请注明出处*******" )  
         )


        (DEFUN C:CKKK()
                (defun dongtai3( enb enb2 fz dxert )  
                (while (and t  ) (princ "\n调好镜像方向请点击鼠标左键" )
                (setq elist (entget enb )) (setq loop t)  (while (and loop  )
                (setq gr (grread t 15 0 )) (setq code (car gr ))
                (setq data (cadr gr )) (cond ((= code 5 )
                (entmod (subst (cons 10 data ) (assoc 10 elist ) elist ) ) )
                ((= code 3 ) (entdel enb ) (setq loop nil) (princ "\n请选择需要执行的矩形" )
                (setq ss1 (ssget '((0 . "LWPOLYLINE") ) )) (setq aa (sslength ss1 ))
                (setq name1 nil) (repeat aa (setq aa (- aa 1 )) (setq name1 (ssname ss1 aa ))
                (setq jj 960) (setq ja 90) (setq pt (xyp-9pt name1 1 ))
                (entmake (list '(0 . "INSERT") (cons 2 enb2 ) (cons 10 pt ) ) )
                 (setq dx_actdyn (vlax-ename->vla-object (entlast ) )) (setq j (- (cadr (xyp-9pt name1 7 ) )
                 (cadr pt ) )) (setq a (- (car (xyp-9pt name1 3 ) ) (car pt ) )) (lm:setdynpropvalue dx_actdyn "E1" j )
                 (lm:setdynpropvalue dx_actdyn "E2" a )  (if (> j 1750 ) (progn   (lm:setdynpropvalue dx_actdyn "E3" jj ) )
                 (progn   (lm:setdynpropvalue dx_actdyn "E3" ja ) ))  (if fz (progn   (lm:setdynpropvalue dx_actdyn "翻转状态1" fz ) )) )
                 (entmake (list '(0 . "INSERT") (cons 2 enb2 ) (cons 10 pt1 ) ) ) (setq enb (entlast )) (setq dxert (vlax-ename->vla-object enb ))
                 (if fz (progn   (lm:setdynpropvalue dxert "翻转状态1" fz ) )) ) ((member code '(11 25 ) )  (if fz (progn    (if (= fz 0 ) (progn   
                 (setq fz 1) (lm:setdynpropvalue dxert "翻转状态1" fz ) )(progn   (setq fz 0) (lm:setdynpropvalue dxert "翻转状态1" fz ) )) ))
                 (dongtai3 enb enb2 fz dxert ) ) ((= code 2 ) (setq loop nil) (entdel enb )
                 (princ "\n***动态按模板单个插入动态块执行完成***Design By---浩浩 2021-1-24******转载请注明出处*******" ) (quit ) ) ) ) )  
                 )
                 (setq en (car (xentsel "\n请选择一个模板动态块:" '((0 . "INSERT") ) ) )) (setq pt1 '(0 0 )) (setq enb2 (get-effectivename en ))
                 (entmake (list '(0 . "INSERT") (cons 2 enb2 ) (cons 10 pt1 ) ) ) (setq enb (entlast )) (setq dxert (vlax-ename->vla-object enb ))
                 (setq fz (lm:getdynpropvalue dxert "翻转状态1" ))
                 (dongtai3 enb enb2 fz dxert )
                 (princ "\n***动态按模板批量插入动态块执行完成***Design By---浩浩 2021-1-24******转载请注明出处*******" )  
         )


        (defun xentsel( msg fil )
                (while
                        (and
                                (not
                                        (and
                                                (setq  el (entsel msg ))
                                                (ssget (cadr el ) fil )
                                        )
                                )  
                        )
                )
                el  
        )
        (defun haohaoxuanjuxing
                ( pt1  / lst1 lst2 lst3 lst4 lst5 nap pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt_list ss a name1 pt_list1 area b e1 e2 )
                 (setq lst1 nil)
                 (setq lst2 nil)
                 (setq lst3 nil)
                 (setq lst4 nil)
                 (setq lst5 nil)
                 (setq lst1 (fp ))
                 (setq pt2 (polar pt1 0 100 ))
                 (setq pt4 (car lst1 ))
                 (setq pt5 (cadr lst1 ))
                 (setq pt6 (polar pt5 (* pi 1.5 ) 100 ))
                 (setq pt3 (polar pt4 (* pi 0.5 ) 100 ))
                 (setq pt7 (inters pt1 pt2 pt3 pt4 nil ))
                 (setq pt8 (inters pt1 pt2 pt5 pt6 nil ))
                 (setq pt9 (polar pt7 (* pi 0.5 ) 0.1 ))
                 (setq pt10 (polar pt7 (* pi 1.5 ) 0.1 ))
                 (setq pt11 (polar pt8 (* pi 0.5 ) 0.1 ))
                 (setq pt12 (polar pt8 (* pi 1.5 ) 0.1 ))
                 (setq pt_list (list pt9 pt10 pt12 pt11 ))
                 (setq ss (ssget "_CP" pt_list '((0 . "LWPOLYLINE") ) ))
                 (setq a (sslength ss ))
                 (repeat a (setq a (- a 1 ))
                 (setq name1 (ssname ss a ))
                 (setq pt_list1 (plpoint (entget name1 ) ))  
                        (if
                                (ptinorout pt_list1 pt1 )
                                 (progn   
                                         (setq area (area-of-verties pt_list1 ))
                                         (setq lst2 (list area name1 ))
                                         (setq lst3 (cons lst2 lst3 ))
                                  )
                        )
                )
                 (setq b (length lst3 ))  
                 (if (> b 1 )
                         (progn   
                                 (setq lst3 (vl-sort lst3 '(lambda ( e1 e2 ) (< (car e1 ) (car e2 ) )  ) ))
                                 (setq lst4 (cadr (car lst3 ) ))
                         )
                         (progn   
                                (setq lst4 (cadr (car lst3 ) ))
                         )
                 )
                 lst4  
         )
        (defun napmod( / nap )  
                (setq nap (getvar "osmode" ))
                (setvar "osmode" 0 )
                nap  
        )
        (defun
                napset
                ( nap )
                (setvar "osmode" nap )  
        )
        (defun ptinorout
                ( pt_list pt  / e1 n i j va va_count )  
                (setq i 0)
                (setq va_count 0)
                (setq n (length pt_list ))
                (setq pt_list (append pt_list (list (car pt_list ) ) ))
                (repeat n
                (setq va (- (angle pt (nth i pt_list ) ) (angle pt (nth (1+ i ) pt_list ) ) ))
                (cond
                ((> va pi ) (setq va (- va pi )) )
                ((< va (* -1 pi ) ) (setq va (+ va pi )) )
                )
                (setq va_count (+ va_count va ))
                (setq i (1+ i )) )  
                (if
                        (< (abs (- (abs va_count ) pi ) ) 1.0e-006 )
                        (progn   t )
                )  
        )
        (defun area-of-verties( pts  / area x1 y1 x2 y2 )  
                (setq area 0)
                (setq pts (cons (last pts ) pts ))
                (setq x1 (caar pts ))
                (setq y1 (cadar pts ))
                (repeat (1- (length pts ) )
                (setq pts (cdr pts ))
                (setq x2 (caar pts ))
                (setq y2 (cadar pts ))
                (setq area (+ (- (* x1 y2 ) (* x2 y1 ) ) area ))
                (setq x1 x2)
                (setq y1 y2) ) (abs (* area 0.5 ) )  
        )
        (defun plpoint( ent  / i pts )  
                (setq i 0)
                (setq pts nil)
                (repeat
                        (length ent )  
                        (if (= (car (nth i ent ) ) 10 )
                                (progn   
                                        (setq pts (append pts (list (cdr (nth i ent ) ) ) ))
                                )
                        )
                        (setq i (1+ i ))
                )
                pts  
        )
        (defun peace:point_centerpoint
                ( plst isz  / n x y z i centerpoint )  
                (setq n (length plst ))
                (setq x 0)
                (setq y 0)
                (setq i 0)  
                (if
                        (= isz T )
                        (progn   (setq z 0) )
                )
                (repeat n
                        (setq x (+ x (car (nth i plst ) ) ))
                        (setq y (+ y (cadr (nth i plst ) ) ))  
                        (if
                                (= isz T)
                                (progn   
                                        (setq z (+ z (caddr (nth i plst ) ) ))
                                )
                        )
                        (setq i (1+ i ))
                )  
                (if
                        (= isz T)
                        (progn   
                                (setq centerpoint (list (/ x n ) (/ y n ) (/ z n ) ))
                        )
                        (progn   
                                (setq centerpoint (list (/ x n ) (/ y n ) ))
                        )
                )
                centerpoint  
        )
        (defun fp
                ( / c03 c08 c04 c05 c07 c06 c09 c01 c02 )  
                (setq c03 (getvar "viewctr" ))
                (setq c03 (trans C03 1 2 ))
                (setq c08 (getvar "viewsize" ))
                (setq c04 (getvar "screensize" ))
                (setq c07 (car c04 ))
                (setq c06 (cadr c04 ))
                (setq c09 (/ (* c08 c07 ) c06 ))
                (setq c01 (list (- (car c03 ) (* 0.5 c09 ) ) (- (cadr c03 ) (* 0.5 c08 ) ) ))
                (setq c02 (list (+ (car c03 ) (* 0.5 c09 ) ) (+ (cadr c03 ) (* 0.5 c08 ) ) ))
                (setq c01 (trans c01 2 1 ))
                (setq c02 (trans c02 2 1 ))
                (list c01 c02 )  
        )
        (defun lst=>ss( lst )
                (setq lst (append lst (list "" ) ))
                (apply
                        'vl-cmdf
                        (cons "_.select" lst )
                )
                (ssget "_p" )  
         )
        (defun get-effectivename
                ( blk  / tem blkname )  
                (setq blkname (cdr (assoc 2 (entget blk ) ) ))  
                (if
                        (wcmatch blkname "`**" )
                        (progn   
                                (if
                                        (and
                                                (setq  tem (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blkname ) ) ) ) '("AcDbBlockRepBTag" ) ) ) ))
                                                (setq  tem (handent (cdr (assoc 1005 tem ) ) ))
                                        )
                                        (progn   
                                                (setq blkname (cdr (assoc 2 (entget tem ) ) ))
                                        )

                                )
                        )
                )
                blkname  
        )
        (defun xyp-9pt
                ( ename site  / minpt maxpt p1 p9 p5 p3 p7 p2 p4 p6 p8 )
                  (defun mid
                  ( p1 p2 )
                  (mapcar '(lambda (x ) (* x 0.5 ) ) (mapcar '+ p1 p2 ) )  
                  )
                  (setq ename
                          (cond
                                  ((= (type ename ) 'ename ) (vlax-ename->vla-object ename ) )
                                  ((= (type ename ) 'vla-object ) ename )
                          )
                  )
                  (vla-getboundingbox ename 'minpt 'maxpt )
                  (setq p1 (vlax-safearray->list minpt ))
                  (setq p9 (vlax-safearray->list maxpt ))
                  (setq p5 (mid p1 p9 ))
                  (setq p3  
                          (if
                                (< (car p9 ) (car p1 ) )
                                  (progn   
                                        (list (car p1 ) (cadr p9 ) (caddr p1 ) )
                                  )
                                  (progn   
                                        (list (car p9 ) (cadr p1 ) (caddr p1 ) )
                                  )
                          )
                  )
                  (setq p7  
                          (if
                                (< (car p9 ) (car p1 ) )
                                  (progn   
                                        (list (car p9 ) (cadr p1 ) (caddr p9 ) )
                                  )
                                  (progn   
                                        (list (car p1 ) (cadr p9 ) (caddr p9 ) )
                                  )
                          )
                  )
                  (setq p2 (mid p1 p3 ))
                  (setq p4 (mid p1 p7 ))
                  (setq p6 (mid p3 p9 ))
                  (setq p8 (mid p7 p9 )) (nth (- site 1 ) (list p1 p2 p3 p4 p5 p6 p7 p8 p9 ) )  
          )
        (defun lm:getdynpropvalue
                ( blk prp )
                (setq prp (strcase prp ))
                (vl-some
                        '
                        (lambda
                                (x )
                                (if
                                        (= prp (strcase (vla-get-propertyname x ) ) )
                                        (vlax-get x (quote value ) )
                                )
                        )
                        (vlax-invoke blk 'getdynamicblockproperties )
                )  
        )
        (defun lm:setdynpropvalue
                ( blk prp val )
                (setq prp (strcase prp ))
                (vl-some
                        '
                        (lambda
                                (x )
                                (if
                                        (= prp (strcase (vla-get-propertyname x ) ) )
                                        (progn
                                                (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x ) ) )
                                                )
                                                (cond (val ) (t ))
                                        )
                                )
                        )
                        (vlax-invoke blk 'getdynamicblockproperties )
                )  
        )
        (defun huazuixiaojuxing
                ( pt1  / a1 a2 a3 a4 aal an en lst1 lst10 lst3 lst4 lst5 lst6 lst7 lst8 lst9 lstta lstta2 lstta3 lstta4 lstta5 lstta6 name1 name2 name3 name4 pp ppe pt12 pt13 pt14 pt15 pt16 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt_list ss ss1 xx )  
                (setq lst1 (fp ))
                (setq pt2 (polar pt1 0 100 ))
                (setq pt12 (polar pt1 (* pi 1.5 ) 100 ))
                (setq pt4 (car lst1 ))
                (setq pt5 (cadr lst1 ))
                (setq pt6 (polar pt5 (* pi 1.5 ) 100 ))
                (setq pt3 (polar pt4 (* pi 0.5 ) 100 ))
                (setq pt13 (polar pt5 pi 100 ))
                (setq pt14 (polar pt4 0 100 ))
                (setq pt7 (inters pt1 pt2 pt3 pt4 nil ))
                (setq pt8 (inters pt1 pt2 pt5 pt6 nil ))
                (setq pt15 (inters pt1 pt12 pt5 pt13 nil ))
                (setq pt16 (inters pt1 pt12 pt4 pt14 nil ))
                (setq pt_list (list (polar pt7 (* pi 0.5 ) 0.01 ) (polar pt8 (* pi 0.5 ) 0.01 ) (polar pt8 (* pi 1.5 ) 0.01 ) (polar pt7 (* pi 1.5 ) 0.01 ) ))
                (setq ss (ssget "_cp" pt_list '((0 . "LINE,LWPOLYLINE,XLINE") ) ))  (if (= ss nil ) (progn   (alert "\nx方向没有选到图元!" ) (quit ) ))
                (entmake
                        (list
                                '(0 . "line")
                                (cons 10 pt7 )
                                (cons 11 pt8 )
                        )
                )
                (setq name1 (entlast ))
                (setq lstta nil)
                (setq lstta2 nil)
                (setq lstta3 nil)
                (setq lst3 nil)
                (setq lst4 nil)
                (setq pp (sslength ss ))
                (repeat
                        pp
                        (setq pp (- pp 1 ))
                        (setq name3 (ssname ss pp ))
                        (setq lstta ($qiu-jiao-dian$ name1 name3 3 ))
                        (setq aal (length lstta ))
                        (repeat
                                aal
                                (setq aal (- aal 1 ))
                                (setq an (nth aal lstta ))
                                (setq an (reverse (cdr (reverse an ) ) ))
                                (setq lstta2 (cons an lstta2 ))
                        )
                )
                (entdel name1 )
                (setq lstta3 (uqpl 0.001 lstta2 ))
                (setq ppe (length lstta3 ))
                (repeat
                         ppe
                         (setq ppe (- ppe 1 ))
                         (setq en (nth ppe lstta3 ))
                         (setq xx (- (car en ) (car pt1 ) ))
                         (cond
                         ((> xx 0 ) (setq lst3 (cons (cons xx en ) lst3 )) )
                         ((< xx 0 ) (setq lst4 (cons (cons xx en ) lst4 )) )
                         )
                 )  
                 (if
                         (or
                                 (= lst3 nil )
                                 (= lst4 nil )
                         )
                         (progn   
                                 (alert "\nX方向有错误!" )
                                 (quit )
                         )
                 )
                 (setq lst5 (vl-sort lst3 '(lambda ( e1 e2 ) (< (car e1 ) (car e2 ) )  ) ))
                 (setq lst6 (vl-sort lst4 '(lambda ( e1 e2 ) (> (car e1 ) (car e2 ) )  ) ))
                 (setq a1 (cdr (car lst5 ) ))
                 (setq a2 (cdr (car lst6 ) ))
                 (setq pt_list (list (polar pt15 0 0.01 ) (polar pt16 0 0.01 ) (polar pt16 pi 0.01 ) (polar pt15 pi 0.01 ) ))
                 (setq ss1 (ssget "_CP" pt_list '((0 . "LINE,LWPOLYLINE,XLINE") ) ))  
                 (if (= ss1 nil ) (progn   (alert "\ny方向没有选到图元!" ) (quit ) ))
                 (entmake
                         (list
                                 '(0 . "LINE")
                                 (cons 10 pt15 )
                                 (cons 11 pt16 )
                         )
                 )
                 (setq name2 (entlast ))
                 (setq lstta4 nil)
                 (setq lstta5 nil)
                 (setq lstta6 nil)
                 (setq lst9 nil)
                 (setq lst10 nil)
                 (setq pp (sslength ss1 ))
                 (repeat pp
                         (setq pp (- pp 1 ))
                         (setq name4 (ssname ss1 pp ))
                         (setq lstta4 ($qiu-jiao-dian$ name2 name4 3 ))
                         (print lstta4 )
                         (setq aal (length lstta4 ))
                         (repeat
                                 aal
                                 (setq aal (- aal 1 ))
                                 (setq an (nth aal lstta4 ))
                                 (setq an (reverse (cdr (reverse an ) ) ))
                                 (setq lstta5 (cons an lstta5 ))
                         )
                 )
                 (entdel name2 )
                 (setq lstta6 (uqpl 0.001 lstta5 ))
                 (setq ppe (length lstta6 ))
                 (repeat ppe
                         (setq ppe (- ppe 1 ))
                         (setq en (nth ppe lstta6 ))
                         (setq xx (- (cadr en ) (cadr pt1 ) ))
                         (cond
                                 ((> xx 0 ) (setq lst10 (cons (cons xx en ) lst10 )) )
                                 ((< xx 0 ) (setq lst9 (cons (cons xx en ) lst9 )) )
                         )
                 )  
                 (if
                 (or (= lst9 nil ) (= lst10 nil ) )
                 (progn   (alert "\ny方向有错误!" ) (quit ) )
                 )
                 (setq lst7 (vl-sort lst9 '(lambda ( e1 e2 ) (> (car e1 ) (car e2 ) )  ) ))
                 (setq lst8 (vl-sort lst10 '(lambda ( e1 e2 ) (< (car e1 ) (car e2 ) )  ) ))
                 (setq a3 (cdr (car lst7 ) ))
                 (setq a4 (cdr (car lst8 ) ))
                        (entmake
                                (list
                                        '(0 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(100 . "AcDbPolyline")
                                        (cons 90 5 )
                                        (cons 10 (list (car a2 ) (cadr a4 ) ) )
                                        (cons 10 (list (car a1 ) (cadr a4 ) ) )
                                        (cons 10 (list (car a1 ) (cadr a3 ) ) )
                                        (cons 10 (list (car a2 ) (cadr a3 ) ) )
                                        (cons 70 1 )
                                )
                        )
                (setq name9 (entlast ))
                (princ )
                name9  
        )




        (defun $qiu-jiao-dian$
                ( ent1 ent2 ys?  / jd obj1 obj2 jd-re ss sss )
           (if (not ys? ) (progn   (setq ys? 3) ))
           (and ent1 (= (type ent1 ) 'ENAME )
           (setq  obj1 (vlax-ename->vla-object ent1 )) )
           (and ent2 (= (type ent2 ) 'ENAME ) (setq  obj2 (vlax-ename->vla-object ent2 )) )
           (if (and obj1 (= (type obj1 ) 'VLA-OBJECT ) obj2 (= (type obj2 ) 'VLA-OBJECT ) )
           (progn   (setq jd (vl-catch-all-apply 'vlax-invoke (list obj1 'intersectwith obj2 ys? ) )) )
           )  (if (vl-catch-all-error-p jd ) (progn   (setq jd nil) ))  
           (if jd (progn    (if (> (length jd ) 3 ) (progn   (while (and jd  ) (setq ss nil)
           (setq ss (mapcar '(lambda ( a  / s )  (setq s ((eval a ) jd )) (set 'jd (cdr jd ) ) s  ) (list 'car 'car 'car ) ))
           (setq sss (append sss (list ss ) )) ) (setq jd sss) (setq sss nil) )(progn   (setq jd (list jd )) )) )) jd  
        )



        (defun dxf
                ( ent i )
                (cdr
                        (assoc
                                i
                                (entget ent )
                        )
                )  
        )
        (defun uqpl
        ( fuzz pl  / l p )  
                (while
                        (and pl  )
                        (setq p (car pl ))  
                        (if
                                (or
                                        (null l )
                                        (not
                                                (vl-some
                                                        '(lambda (x)
                                                                (equal x p fuzz ) ) l
                                                        )
                                                )
                                        )
                                 (progn   (setq l (cons p l )) )
                                 )
                                (setq pl (cdr pl ))
                 )
                 (reverse l )  
        )