cherche lsp pour longeur surface perimetre

[zizouspawn]

Salut à tous

Auriez-vous des lsp pour avoir directement les longueurs les surfaces le perimetre pour tocad 2002 merci d'avance

[capde06]

(defun c:srf()

(setvar "cmdecho" 0)

(princ "\nIncription des surfaces d'un polygone ou d'un cercle")

(setq ent (entsel))

(setq test (cdr(assoc 70 (entget (car ent)))))

(if (or (= 0 test)(= 128 test))

(alert "Attention Le polygone n'est pas fermé")

(progn

(setq p1 (getpoint"\nPoint d'insertion du texte :"))

(command "_AREA" "E" ent)

;(setq ttext (strcat "%%uSurface "(rtos (getvar "area") 2 2)" m2%%u"))

(setq ttext (strcat "Surface "(rtos (getvar "area") 2 2)" m2"))

(setq h_style (cdr(assoc 40(tblsearch "STYLE" (getvar "textstyle")))))

(if (= h_style 0)

(command "_TEXT" p1 "" pause ttext)

(command "_TEXT" p1 pause ttext)

)

)

)

(princ)

)

[(gile)]

Salut,

 

Si ça te suffit d'avoir le périmètre et la surface affichés sur la ligne de commande, tu peux te faire un bouton avec cette macro :

 

^C^C_area;o;/;

[(gile)]

Ou bien, un peu plus sophistiqué, un LISP qui retourne le résultat dans une boite de dialogue où il est proposé d'en faire un Mtext.

Ça fonctionne avec les arcs, les cercles, les ellipses, les polylignes ouvertes ou fermées, les regions et les splines.

 

;;; PS (gile) Retourne le périmètre et la surface de l'objet sélectionné et propose
;;; de mettre le résultat dans un objet texte (Merci à Patrick_35 pour MsgBox).
;;; Fonction avec les arcs, cercles, ellipses, polylignes, regions et splines.

(vl-load-com)

(defun MsgBox (Titre Boutons Message Time / Reponse WshShell)
 (setq WshShell (vlax-create-object "WScript.Shell"))
 (setq	Reponse	(vlax-invoke
	  WshShell
	  'Popup
	  Message
	  Time
	  Titre
	  (itoa Boutons)
	)
 )
 (vlax-release-object WshShell)
 Reponse
)

(defun c:ps (/ AcDoc Space obj aire param perim str)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (if (and
(setq obj (car (entsel)))
(setq obj (vlax-ename->vla-object obj))
(not
  (vl-catch-all-error-p
    (setq aire (vl-catch-all-apply 'vla-get-area (list obj)))
  )
)
(or
  (and
    (not
      (vl-catch-all-error-p
	(setq param
	       (vl-catch-all-apply 'vlax-curve-getEndParam (list obj))
	)
      )
    )
    (setq perim (vlax-curve-getDistAtParam obj param))
  )
  (not
    (vl-catch-all-error-p
      (setq perim (vl-catch-all-apply 'vla-get-perimeter (list obj)))
    )
  )
)
(setq str (strcat "Périmètre : "
		  (rtos perim 2 2)
		  "\nSurface : "
		  (rtos aire 2 2)
	  )
)
     )
   (if
     (= (MsgBox "Périmètre & surface"
	 4
	 (strcat str "\n\nCréer un objet texte ?")
	 0
 )
 6
     )
      (progn
 (vla-StartundoMark AcDoc)
 (vla-addMtext
   Space
   (vlax-3d-point
     (trans (getpoint "\nSpécifiez le point d'insertion: ") 1 0)
   )
   0.0
   str
 )
 (Vla-EndUndoMark AcDoc)
      )
   )
   (alert "Objet non valide")
 )
 (princ)
)

(princ
 "\"Périmètre & surface\" chargé, taper ps pour lancer la commande."
)
(princ) 

 

[Edité le 25/1/2007 par (gile)]