copier dans le presse papier

[Zugzwang]

bonjour

je voudrais dans un Lisp copier le résultat d'un calcul (un réel arrondi à 2 chiffres) dans le presse papier... (pour le coller dans excel)

y a t il une fonction pour ça genre (set clipboard variable)?

comme je trouve pas, je me doute qu'il faut passer par du VBA... mais c'est plus compliqué à chercher du coup...

si qq1 sait comment ça marche

merci 

[Zugzwang]

je me suis souvenu que (gille) fait souvent référence au swamp ou j'ai trouvé cette paire de fonction de Lee Mac qui font le job

merci à lui...

;;  http://www.theswamp.org/index.php?topic=21764.msg263322#msg263322
(defun _SetClipBoardText ( text / htmlfile result )

    ;;  Caller's sole responsibility is to pass a
    ;;  text string. Anything else? Pie in face.

    (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow)
               'ClipBoardData
            )
           'SetData  "Text"  text)
    )
    (vlax-release-object htmlfile)
    text
)


;;;;;;;;;;;;

;;  MP
(defun _GetClipBoardText( / htmlfile result )

    (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow)
               'ClipBoardData
            )
           'GetData "Text")
    )
    (vlax-release-object htmlfile)
    result
)

 

[Zugzwang]

pour info, voici 3 routines pour aider à la saisie des métrés qui copient l'Alert dans le presse papier pour pouvoir faire Ctrl V dans Excel

de rien...

 

;; 3 lisp inspirés du regrété Patrick_35
;; ils font la somme de longueurs ou de surfaces d'objets sélectionnés 
;; https://cadxp.com/topic/40634-somme-par-%C3%A9paisseur-de-polylignes/?do=findComment&comment=227427
;; merci à lui

;; Tous ces lisp posent une alerte qui affiche le résultat et le stocke cans le clipboard pour coller dans Excel
;;
;; STP exclusivement des poly mais trie les résultats par spécificités
;; Constantwidth pour les épaisseurs, Layer pour les calques, Color pour les couleurs, Linetype pour les types de ligne LinetypeScale pour les échelle de type de ligne
;;
;; STS qui fait les sommes de surfaces de poly fermées exclusimenment
;;
;; STL qui fait la somme de toutes les longueurs poly, ligne, et splines  (sauf les cercles ) 


(defun c:stp (/ kw ent ele lst sel res tot filtre)
  (initget 1 "Epaisseur Layer Couleur Typeligne Scaleline")
  (setq	kw
	 (getkword
	   "\nspécificité du tri ? [Epaisseur Layer Couleur Typeligne Scaleline]: "
	 )
  )

  (cond
    ((= "Epaisseur" kw) (setq filtre 'Constantwidth))
    ((= "Layer" kw) (setq filtre 'Layer))
    ((= "Couleur" kw) (setq filtre 'Color))
    ((= "Typeligne" kw) (setq filtre 'Linetype))
    ((= "Scaleline" kw) (setq filtre 'LinetypeScale))
  )

  (and
    (ssget (list (cons 0 "*POLYLINE")))
    (progn
      (vlax-for	ent (setq sel
			   (vla-get-activeselectionset
			     (vla-get-activedocument (vlax-get-acad-object))
			   )
		    )
	(if (setq ele (assoc (vlax-get ent filtre) lst))
	  (setq
	    lst	(subst (list (car ele)
			     (cons (vla-get-length ent) (cadr ele))
		       )
		       ele
		       lst
		)
	  )
	  (setq	lst (cons (list	(vlax-get ent filtre)
				(list (vla-get-length ent))
			  )
			  lst
		    )
	  )
	)
      )
      (vla-delete sel)
      (setq tot 0)
      (mapcar
	'(lambda (x)
	   (setq tot (+ tot (setq res (apply '+ (cadr x)))))
	   (princ "\nTotal polyligne(s) type ")
	   (princ filtre)
	   (princ " --> ")
	   (princ (car x))
	   (princ (strcat " : " (rtos res)))
	   (print)
	; copie dans le presse papier du total, la boite d'alerte permet de bloquer le programe le temps qu'on colle dans excel
	   (_SetClipBoardText (strcat (rtos res)))
	   (cond
	     ((= "Epaisseur" kw)
	      (alert (strcat kw " -->" (rtos (car x)) " = " (rtos res)))
	     )
	     ((= "Layer" kw)
	      (alert (strcat kw " -->" (car x) " = " (rtos res)))
	     )
	     ((= "Couleur" kw)
	      (alert (strcat kw " -->" (rtos (car x)) " = " (rtos res)))
	     )
	     ((= "Typeligne" kw)
	      (alert (strcat kw " -->" (car x) " = " (rtos res)))
	     )
	     ((= "Scaleline" kw)
	      (alert (strcat kw " -->" (rtos (car x)) " = " (rtos res)))
	     )
	   )
	 )
	(vl-sort lst '(lambda (a B) (< (car a) (car B))))
      )
      (print)
      (_SetClipBoardText (strcat (rtos tot)))
      (princ (strcat "\n fin de calcul  Total : " (rtos tot)))
    )
  )
  (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;    somme des surfaces de ploy fermées  sélectionnées             ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:sts (/ sf SEL X)
  (setq	sf  0
	sel nil
  )
  (while (not sel)
    (setq sel (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
  )
  (repeat (setq x (sslength sel))
    (setq
      sf (+ sf
	    (vla-get-area
	      (vlax-ename->vla-object (ssname sel (setq x (1- x))))
	    )
	 )
    )
  )

  (_SetClipBoardText (strcat (rtos sf)))
  (princ (strcat "\n Surface : : " (rtos sf)))
  (alert (strcat "\n Surface : : " (rtos sf)))
  (princ)
)

;;;  (print (strcat "surface : " (rtos sf) " ."))
;;;  (setvar "textsize" 0.3)
;;;  (command "texte" pause "" "" (rtos sf))
;;;  (command "MODIFTABLEAU" pause (rtos sf) )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;    somme des longueurs de lignes poly spline  sélectionnées      ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:STL (/ LG LT SEL tube X)



  (vl-load-com)

  (setq	lg   0.0
	lt   0.0
	sel  nil
	tube nil
  )
  (while (not sel)
    (setq sel (ssget (list '(-4 . "<OR")	 '(0 . "*POLYLINE")
			   '(0 . "SPLINE")	 '(0 . "LINE")
			   '(-4 . "OR>")
			  )
	      )
    )
  )
  (setq x (sslength sel))
  (repeat x
    (setq x (- x 1))
    ;; pour décaler et arriver à zéro à la fin on décrémente au début (le 1ere élément de la liste est en zéro)
    (setq tube (ssname sel x))

    (if	(= (cdr (assoc 0 (entget tube))) "SPLINE")

      ;; si c'est une spline
      (progn
	(command "aire" "ob" tube)
	(setq lt (getvar "perimeter"))
      )
      ;; si c'est autre chose
      (progn
	(setq lt
	       (vla-get-Length
		 (vlax-ename->vla-object (ssname sel x))
	       )
	)
      )
    )
    (setq lg (+ lt lg))
  )

  (_SetClipBoardText (rtos lg))
  (Alert (strcat "Longueur :" (rtos lg)))

					;(command "MODIFTABLEAU" pause (rtos lg) )


  (princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  http://www.theswamp.org/index.php?topic=21764.msg263322#msg263322
;;  Caller's sole responsibility is to pass a
;;  text string. Anything else? Pie in face.

(defun _SetClipBoardText (text / htmlfile result)
  (setq	result
	 (vlax-invoke
	   (vlax-get
	     (vlax-get (setq htmlfile (vlax-create-object "htmlfile"))
		       'ParentWindow
	     )
	     'ClipBoardData
	   )
	   'SetData
	   "Text"
	   text
	 )
  )
  (vlax-release-object htmlfile)
  text
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun _GetClipBoardText (/ htmlfile result)

  (setq	result
	 (vlax-invoke
	   (vlax-get
	     (vlax-get (setq htmlfile (vlax-create-object "htmlfile"))
		       'ParentWindow
	     )
	     'ClipBoardData
	   )
	   'GetData
	   "Text"
	 )
  )
  (vlax-release-object htmlfile)
  result
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

 

[lili2006]

Bonne Année à toutes et tous !!

 

Merci pour ce rappel @Zugzwang,😎

[Zugzwang]

pour ma culture...

qq1 sait pourquoi Lee Mac fait référence à du html pour le clipboard?

ce htmlfile me perturbe un peu même si ça à l'air d'un nom arbitraire, pourquoi celui là ?