Archive

[sofianerm]

Archive

 

[(gile)]

Salut,

Ça devrait répondre à ta demande:

(defun c:TEST (/ countBy ssToList getLength makeTable ss inspt)
  
  (defun countBy (fun lst / f key sub acc)
    (setq f (eval fun))
    (foreach x lst
      (setq acc
	     (if (setq sub (assoc (setq key (f x)) acc))
	       (subst (cons key (1+ (cdr sub))) sub acc)
	       (cons (cons key 1) acc)
	     )
      )
    )
  )
  
  (defun ssToList (ss / i lst)
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  
  (defun getLength (arc / lg loop)
    (setq lg (getpropertyvalue arc "Length"))
    (defun loop	(lst)
      (cond
	((null lst) "> 12")
	((<= lg (car lst)) (car lst))
	(T (loop (cdr lst)))
      )
    )
    (loop '(1.2	  1.5	2.0   2.5   3.0	  3.5	4.0   4.5   5.0	  5.5
	    6.0	  6.5	7.0   7.5   8.0	  8.5	9.0   9.5   10.0  10.5
	    11.0  11.5	12.
	   )
    )
  )
  
  (defun makeTable (lst inspt / table count)
    (vl-load-com)
    (setq table	(vla-addtable
		  (vla-get-modelspace
		    (vla-get-activedocument (vlax-get-acad-object))
		  )
		  (vlax-3d-point inspt)
		  (+ (length lst) 2)
		  2
		  15
		  50
		)
    )
    (vla-put-TitleSuppressed table :vlax-false)
    (vla-setText table 0 0 "QUANTITATIF")
    (setq row 1)
    (vla-setText table row 0 "Longueur")
    (vla-setText table row 1 "Quantité")
    (foreach p lst
      (setq row (1+ row))
      (vla-settext table row 0 (car p))
      (vla-settext table row 1 (cdr p))
      (vla-setcellalignment table row 0 5)
      (vla-setcellalignment table row 1 5)
    )
    (vla-TransformBy
      table
      (vlax-TMatrix
	(append
	  (mapcar
	    (function
	      (lambda (v o)
		(append (trans v 0 1 T) (list o))
	      )
	    )
	    '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
	    (trans '(0. 0. 0.) 1 0)
	  )
	  '((0. 0. 0. 1.))
	)
      )
    )
  )
  
  (if
    (and
      (setq ss (ssget "_X" (list (cons 0 "ARC"))))
      (setq inspt (getpoint "\nPoint d'insertion: "))
    )
     (makeTable (countBy 'getLength (ssToList ss)) inspt)
  )
  (princ)
)

 

[sofianerm]

Archive