Cotation linéaire

[x13]

Je voudrais modifier un programme permettant d'activer ou désactiver la

deuxième ligne d'attache et sa pointe de flèche associée.

 

Voici la manière de procédé que j'utilise:

- Dessin d'une cote linéaire et sélection de celle-ci.

-Dans propriété je sélectionne ARROW2 et je lui donne la valeur NONE

puis je sélectionne EXT LINE 2 et lui attribut la valeur OFF et je ferme la boîte de

dialogue propriété. Le résultat est une cote linéaire avec une seule ligne d'attache et une

seule pointe de flèche ou barre oblique, très utile pour les dessins d'atelier de charpente

d'acier.

 

Ci-joint deux programmes que j'ai essayé de modifier sans résultat.

 

Pouvez-vous m'indiquer où est l'erreur et la marche à suivre.

 

Merci à l'avance de votre aide.

 

Voici le premier programme.

 

;Tip1576: DIMSEA2.LSP Toggle Extension Line ©1999, Billy Wooten

Toggle pointe de flèche (janv. 2004) François Huot

 

(defun C:DIMSEA2 (/ QT FLÈCHE) ;;;ligne modifiée

(setq QT (getvar "dimse2" ))

(setq FLÈCHE (getvar "dimblk" )) ;;;ligne ajoutée

(if (= QT 0)

(if (= FLÈCHE OBLIQUE) ;;;ligne ajoutée

(progn

(setvar "dimse2" 1)

(setvar "dimblk" none) ;;;ligne ajoutée

(princ "\nSupprimer deuxième ligne d'attache et pointe de flèche")

) ;_ end of progn

) ;_ end of if

(if (= QT 1)

(if (= FLÈCHE OFF) ;;;ligne ajoutée

(progn

(setvar "dimse2" 0)

(setvar "dimblk" oblique) ;;;ligne ajoutée

(princ "\nInclure Deuxième ligne d'attache et pointe de flèche")

) ;_ end of progn

) ;_ end of if

(princ)

) ; end dimsea2

 

(princ "\n Taper DIMSEA2 pour démarrer ")

 

Voici le deuxième programme.

 

;***************************** XTSWITCH2.LSP ***********************************

; Purpose: Switches Extension Lines and arrow On or Off

; Created: 7/24/97

; Modified: 11/25/97 added error handler

; Modified: 01/20/2004 added arrow on or off (François Huot, Montmagny, Québec)

; Author: Herman Mayfarth

; Tekton Construction Services

; h_mayfarth@compuserve.com

; Copyright © 1997 Herman Mayfarth. Permission granted to freely use

; and redistribute without fee so long as copyright notice remains intact.

; Provided "as is" and with all faults. No warranty express or implied.

;

;******************************************************************************

;; error handler

(defun tcserr(msg)

(exitsw)

(if

(or

(= msg "Function cancelled")

(= msg "quit / exit abort")

)

(princ)

(princ (strcat "\nError: msg"))

);end if

(princ)

);end tcserr

;;----------------------------------------------------------------------------

;; startup function

(defun strtsw()

(command "_.UNDO" "BEGIN")

(setq olderr *error*

*error* tcserr)

(setq oldecho (getvar "cmdecho"))

(setvar "cmdecho" 0)

(princ)

);end strtsw

;;---------------------------------------------------------------------------

;; exit function

(defun exitsw()

(setvar "cmdecho" oldecho)

(setq *error olderr

olderr nil)

(command "_.UNDO" "END")

(princ)

);end exitsw

;;---------------------------------------------------------------------------

;; basic switch function

(defun tcs_xtln_switch (val / s a e1 pt d1 d2 which switchval)

;; initialize variables

(setq s T)

(setq which nil)

(setq switchval val)

;; get dimension to change

(while s

(setq a (entsel "\nSelectionner la ligne d'attache et pointe de flèche à changer:\n"))

(setq pt (trans(cadr a) 1 0))

(setq e1 (entget (car a)))

(if (= "DIMENSION" (cdr(assoc 0 e1)))

(setq s nil)

);end if

);end while

 

;; evaluate distances to definition points

(setq d1 (distance pt (cdr(assoc 13 e1))))

(setq d2 (distance pt (cdr(assoc 14 e1))))

 

;; decide which extension line and arrow to toggle

(cond

((> d1 d2) (setq which "DIMSE2"));toggle DIMSE2

;((> d1 d2) (setq which "DIMBLK"));toggle DIMBLK ;;;; ligne ajoutée

((> d2 d1) (setq which "DIMSE1"));toggle DIMSE1

;((> d2 d1) (setq which "DIMBLK"));toggle DIMBLK ;;;; ligne ajoutée

(T nil)

);end cond

;; do it!

(command "_.dimoverride" which switchval "" (car a) "")

(princ)

);end tcs_xtln_switch

;;----------------------------------------------------------------------------

;; turn on line and arrow

(defun C:XTL2ON( / oldecho olderr)

(strtsw)

(tcs_xtln_switch 0)

(tcs_dimblk_switch "none") ;;; ligne ajoutée

(exitsw)

(princ)

);end XTL2ON

;;--------------------------------------------------------------------------

;; turn off line and arrow

(defun C:XTL2OFF( / oldecho olderr)

(strtsw)

(tcs_xtln_switch 1)

(tcs_dimblk_switch "oblique") ;;;ligne ajoutée

(command "_.REDRAW")

(exitsw)

(princ)

);end XTL2OFF

;;-------------------------------------------------------------------------

;; load prompts

(princ "\nXTSWITCH2 loaded....")

(princ "\nXTL2ON turns on extension line and arrow,XTL2OFF turns it off") ;;;ligne modifiée

(princ)

 

[Eric]

Bonjour,

 

J'avais créer une fonction (icône) qui faisait à peut près ca mais en simple macro pour ceux que ca intéresse.

 

Ca fonctionne aussi sur LT.

 

^C^Cselect;\dimsd1;1;dimse1;1;_-dimstyle;a;p;;dimsd1;0;dimse1;0;

 

 

[Labletech]

Je vais répondre dans le même sens qu'Eric. En plus je trouve ces programmes bigrement longs pour un traitement aussi simple. J'ai fait il y a quelques années de cela 2 tout petits lisp qui utilisent les variables systèmes qui sont décrites par Eric. Ils marchent encore sur des versions 2000 et 2002.

 

L'intérêt c'est que c'est du lisp et donc ca éclairera peut-être notre interlocuteur sur la façon de l'utiliser. ;)

On trouvera mon petit programme à l'adresse suivante:

http://www.infographie-formation.fr

 

puis rubrique Eformation

et ensuite rubrique Download ensuite c'est très facile ...

:P

[x13]

Merci beaucoup à Éric et Labletech pour leurs solutions.

 

Je vais les essayer dès aujourd'hui, maintenant je sais que c'est la variable DIMSD et non DIMBLK qu'il faut utilisé.

 

Salutations, x13