Jump to content

LISP : cotation


Recommended Posts

Bonsoir,

 

je suis à la recherche d'un LISP ou autre programme capable de coter un ensemble de ligne sélectionnées avec ou sans un fenêtre de réglage.

De plus, je souhaiterais pouvoir régler si ces côtes sont annotatives ou non.

En somme je souhaiterai faciliter ma cotation de dessin, car elle me prend un temps de fou.

 

Après avoir cherché sur le forum ou les pages de LISP bien connues, je n'ai pas trouvé...

 

Merci à vous,

 

 

P.S :

Sur ce site : http://ma83.free.fr/info/acadlisp.html,

j'avais trouvé un lisp "COTP.lsp" mais le lien et mort donc impossible de tester...

Link to post
Share on other sites

Bonjour :)

 

Pour ma part j'utilise ceci:

 


;;; SEGLEN par GC version 3.00 - 2011/01
;;; Crée un texte sur chaque segment de ligne ou polyligne sélectionné
;;; dont la valeur est la longueur du segment.
;;; http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=31392#pid139304

(defun c:seglen300	(/ *error* format temp file dcl_id slst	st jlst	ju ht pre suf ro fs stat ss space n obj
	 len pa	txt fs ent pt)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))

 ;; redéfintion locale de *error*
 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;; sous routine de formatage du texte : justification et rotation
 (defun format	(txt / ang)
   (vla-put-Alignment
     txt
     (cond
((= ju "Gauche") acAlignmentLeft)
((= ju "Centre") acAlignmentCenter)
((= ju "Droite") acAlignmentRight)
((= ju "Milieu") acAlignmentMiddle)
((= ju "Haut Gauche") acAlignmentTopLeft)
((= ju "Haut Centre") acAlignmentTopCenter)
((= ju "Haut Droite") acAlignmentTopRight)
((= ju "Milieu Gauche") acAlignmentMiddleLeft)
((= ju "Milieu Centre") acAlignmentMiddleCenter)
((= ju "Milieu Droite") acAlignmentMiddleRight)
((= ju "Bas Gauche") acAlignmentBottomLeft)
((= ju "Bas Centre") acAlignmentBottomCenter)
((= ju "Bas Droite") acAlignmentBottomRight)
     )
   )
   (or	(= ju "Gauche")
(vla-put-TextAlignmentPoint txt (vlax-3d-point pt))
   )
   (and
     (= ro "al")
     (setq ang	(angle '(0. 0. 0.)
	       (vlax-curve-getfirstDeriv
		 obj
		 (vlax-curve-getParamAtPoint obj pt)
	       )
	)
     )
     (if (and (= fs "1") (minusp (cos ang)))
(vla-put-Rotation txt (+ pi ang))
(vla-put-Rotation txt ang)
     )
   )
   (vla-put-StyleName txt st)
 )

 ;; création de la boite de dialogue (écriture dans un fichier temporaire)
 (setq	temp (vl-filename-mktemp "Tmp.dcl")
file (open temp "w")
 )
 (write-line
   (strcat
     "IncTxt:dialog{"
     "label=\"Longueurs de segments\";"
     ":boxed_column{"
     "label=\"Mise en forme\";"
     ":popup_list{"
     "label=\"Style\";key=\"st\";edit_width=16;}"
     ":popup_list{"
     "label=\"Justification\";key=\"ju\";edit_width=16;}"
     ":edit_box{"
     "label=\"Hauteur\";key=\"ht\";edit_width=5;allow_accept=true;}"
     ":edit_box{"
     "label=\"Préfixe\";key=\"pre\";edit_width=16;allow_accept=true;}"
     ":edit_box{"
     "label=\"Suffixe\";key=\"suf\";edit_width=16;allow_accept=true;}"
     ":boxed_column{label=\"Orientation\";"
     ":radio_row{key=\"ro\";"
     ":radio_button{label=\"Horizontal\";key=\"ho\";}"
     ":radio_button{label=\"Aligné\";key=\"al\";}}"
     ":toggle{label=\"Forcer le sens de lecture\";key=\"fs\";}}}"
     "ok_cancel;}"
    )
   file
 )
 (close file)

 ;; initialisation et chargement de la boite de dialogue
 (setq dcl_id (load_dialog temp))
 (if (not (new_dialog "IncTxt" dcl_id))
   (exit)
 )
 (while (setq st (tblnext "STYLE" (not st)))
   (if	(/= (cdr (assoc 2 st)) "")
     (setq slst (cons (cdr (assoc 2 st)) slst))
   )
 )

 ;; liste déroulante "Style"
 (setq slst (reverse slst))
 (start_list "st")
 (mapcar 'add_list slst)
 (end_list)

 ;; liste déroulante "Justification"
 (setq	jlst '("Gauche"		 "Centre"	   "Droite"	     "Milieu"
       "Haut Gauche"	 "Haut Centre"	   "Haut Droite"     "Milieu Gauche"
       "Milieu Centre"	 "Milieu Droite"   "Bas Gauche"	     "Bas Centre"
       "Bas Droite"
      )
 )
 (start_list "ju")
 (mapcar 'add_list jlst)
 (end_list)

 ;; initialisation des variables
 (setq	st  (getvar "TEXTSTYLE")	; style de texte
ju  "Bas Centre"		; justification (voir liste)
ht  (cond			; hauteur de texte
      ((vlax-ldata-get "SegLen" "TextHeight"))
      ((getvar "TEXTSIZE"))
    )
pre ""				; préfixe
suf ""				; suffixe
ro  "al"			; rotation ("al" ou "ho")
fs  "1"				; sens écriture ("1" ou "0")
 )


 ;; affichage des éléments en fonction des variables
 (set_tile "st" (itoa (vl-position st slst)))
 (set_tile "ju" (itoa (vl-position ju jlst)))
 (set_tile "ht" (rtos ht))
 (set_tile "pre" pre)
 (set_tile "suf" suf)
 (set_tile "ro" ro)
 (set_tile "fs" fs)

 ;; définitions des actions des éléments
 (action_tile "st" "(setq st (nth (atoi $value) slst))")
 (action_tile "ju" "(setq ju (nth (atoi $value) jlst))")
 (action_tile
   "ht"
   "(if (and (numberp (distof $value))
    (< 0 (distof $value)))
    (setq ht (distof $value))
    (progn
    (alert \"Nécessite un nombre réel strictement positif\")
    (set_tile \"ht\" (rtos ht))
    (mode_tile \"ht\" 2))))"
 )
 (action_tile "pre" "(setq pre $value)")
 (action_tile "suf" "(setq suf $value)")
 (action_tile "ho" "(setq ro $key) (mode_tile \"fs\" 1)")
 (action_tile "al" "(setq ro $key) (mode_tile \"fs\" 0)")
 (action_tile "fs" "(setq fs $value)")
 (action_tile "accept" "(done_dialog 1)")
 (action_tile "cancel" "(done_dialog 0)")
 (setq stat (start_dialog))

 ;; déchargemet de la boite de dialogue et suppression du fichier DCL
 (unload_dialog dcl_id)
 (vl-file-delete temp)

 ;; Sélection des polylignes et lignes
 (if
   (and
     (= stat 1)
     (setq ss (ssget '((410 . "Model")
		(-4 . "<OR")
		(0 . "LINE")
		(-4 . "<AND")
		(0 . "*POLYLINE")
		(-4 . "<NOT")
		(-4 . "&")
		(70 . 112)
		(-4 . "NOT>")
		(-4 . "AND>")
		(-4 . "OR>")
	       )
       )
     )
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (vlax-ldata-put "SegLen" "TextHeight" ht)
      (setq space (vlax-get *acdoc*
		     (if (= (getvar 'cvport) 1)
		       'PaperSpace
		       'ModelSpace
		     )
	   )
      )

      ;; traitement du jeu de sélection
      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
 (if (= (vla-get-ObjectName obj) "AcDbLine")
   ;; lignes
   (progn
     (setq len (vlax-curve-getDistAtParam
		 obj
		 (vlax-curve-getEndParam obj)
	       )
	   pt  (vlax-curve-getPointAtDist obj (/ len 2.0))
     )
     (format
       (vla-addText
	 space
	 (strcat pre (rtos len) suf)
	 (vlax-3d-point pt)
	 ht
       )
     )
   )
   ;; polylignes
   (repeat (setq pa (fix (vlax-curve-getEndParam obj)))
     (setq
       len (- (vlax-curve-getDistAtParam obj pa)
	      (vlax-curve-getDistAtParam obj (setq pa (1- pa)))
	   )
       pt  (vlax-curve-getPointAtparam obj (+ pa 0.5))
     )
     (format
       (vla-addText
	 space
	 (strcat pre (rtos len) suf)
	 (vlax-3d-point pt)
	 ht
       )
     )
   )
 )
      )
      (vla-Delete ss)
    )
 )
 (*error* nil)
)


 

Je ne retrouve plus le lien original, mais créé par "GC" peut être (gile)? :rolleyes:

 

Bonne journée!

Link to post
Share on other sites

Hello

 

NON c par le REGRETTE Patrick_35 !!

 

J utilise très souvent cette routine qui génère des Textes statiques...

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

 

Automne 2020, la retraite

Autodesk Expert Elite Team

Link to post
Share on other sites

Bonjour,

 

Merci pour le LISP, après essai, je m'attendais plus à avoir une ligne de cotation. Là mon texte est collé et sans ligne de cotation. :unsure: :unsure: :unsure:

Le crabe, tu dis qu'ils sont statiques ? Pourtant la fenêtre indique la possibilité de les avoir en annotatif

Link to post
Share on other sites

Hello

 

Je disais Texte statique par opposition à une Cotation dynamique (associée à la Géométrie) !

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

Autodesk Expert Elite Team

Link to post
Share on other sites

Hello

 

Encore MERCI Gilles !

 

Alors et si tu essayais cette routine "LW_DIM" pour une LWPOLYLINE 2D !?

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;; Routine LW_DIM par GC
;; pour coter une polyligne "legere" en mode ALIGNE 
;; Avec le style de Cotation COURANT

(defun c:Lw_Dim (/ js ent dxf_ent lst_pt AcDoc Space)
(princ "\nSelectionner la Polyligne 2D (LWPline) a coter ... ")
(setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
(cond
(js
(vl-load-com)
(setq
dxf_ent (entget (setq ent (ssname js 0)))
lst_pt (mapcar
'(lambda (x) (trans x ent 0))
(mapcar
'cdr
(vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
)
)
)
(if (= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
(setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(if (equal (car lst_pt) (last lst_pt) 1e-9)
(vla-addDimAngular
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr (reverse lst_pt)))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
(polar
(car lst_pt)
(angle
(car lst_pt)
(mapcar '*
(mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
'(0.5 0.5 0.5)
)
)
(* 10 (getvar "DIMTXT"))
)
)
)
)
(while (cdr lst_pt)
(vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
(polar
(mapcar '*
(mapcar '+ (car lst_pt) (cadr lst_pt))
'(0.5 0.5 0.5)
)
(+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
(* 10 (getvar "DIMTXT"))
)
)
)
(setq lst_pt (cdr lst_pt))
)
)
)
(prin1)
) 

Autodesk Expert Elite Team

Link to post
Share on other sites

Hello

 

C SURTOUT Gilles qu il faut remercier !!

 

ET j ai la meme routine "LW_DIM__v2" de Gilles qui en plus des cotes alignees , realise les cotes angulaires sur tous les angles !

 

Ca t interesse !?

 

---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !?

---- Traiter N PLines 2D et non pas UNE SEULE !!

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

Autodesk Expert Elite Team

Link to post
Share on other sites

Hello

 

C SURTOUT Gilles qu il faut remercier !!

 

ET j ai la meme routine "LW_DIM__v2" de Gilles qui en plus des cotes alignees , realise les cotes angulaires sur tous les angles !

 

Ca t interesse !?

 

---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !?

---- Traiter N PLines 2D et non pas UNE SEULE !!

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 

Je pense en avoir besoin, donc oui, avec plaisir !

Link to post
Share on other sites

Hello

 

C SURTOUT Gilles qu il faut remercier !!

 

Routine "LW_DIM__v2" de Gilles qui en plus des cotes alignees , realise les cotes angulaires sur tous les angles !

 

---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !?

---- Traiter N PLines 2D et non pas UNE SEULE !!

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 

 

;; Routine LW_DIM__v2 par GC
;; pour coter une polyligne 
;; en mode ALIGNE & ANGULAIRE 
;; Avec le style de Cotation COURANT

(defun c:Lw_Dim__v2 (/ js ent dxf_ent lst_pt AcDoc Space)
(princ "\nSelectionner la Polyligne 2D (LWPline) a coter ... ")
(setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
(cond
(js
(vl-load-com)
(setq
dxf_ent (entget (setq ent (ssname js 0)))
lst_pt (mapcar
'(lambda (x) (trans x ent 0))
(mapcar
'cdr
(vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
)
)
)
(if (= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
(setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(if (equal (car lst_pt) (last lst_pt) 1e-9)
(vla-addDimAngular
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr (reverse lst_pt)))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
(polar
(car lst_pt)
(angle
(car lst_pt)
(mapcar '*
(mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
'(0.5 0.5 0.5)
)
)
(* 10 (getvar "DIMTXT"))
)
)
)
)
(while (cdr lst_pt)
(vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
(polar
(mapcar '*
(mapcar '+ (car lst_pt) (cadr lst_pt))
'(0.5 0.5 0.5)
)
(+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
(* 10 (getvar "DIMTXT"))
)
)
)
(if (cddr lst_pt)
(vla-addDimAngular
Space
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point (car lst_pt))
(vlax-3d-point (caddr lst_pt))
(vlax-3d-point
(polar
(cadr lst_pt)
(angle
(cadr lst_pt)
(mapcar '*
(mapcar '+ (caddr lst_pt) (car lst_pt))
'(0.5 0.5 0.5)
)
)
(* 10 (getvar "DIMTXT"))
)
)
)
)
(setq lst_pt (cdr lst_pt))
)
)
)
(prin1)
) 

Autodesk Expert Elite Team

Link to post
Share on other sites

---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !?

---- Traiter N PLines 2D et non pas UNE SEULE !!

 

Bonjour Patrice

 

Rapidement ceci devrait convenir:

;; 01/09/2020 variante de la Routine LW_DIM par GC
;; pour coter "plusieures" polyligne "legere" en mode ALIGNE 
;; Avec le style de Cotation COURANT
(defun c:nLw_Dim (/ js Lw_Dim ssmap AcDoc Space)


 ;; Fonctions auxiliaire
 (defun ssmap (fun ss / n)
   (if	(= 'PICKSET (type ss))
     (repeat (setq n (sslength ss))
(apply fun (list (ssname ss (setq n (1- n)))))
     )
   )
 )

 (defun Lw_Dim	(ent / dxf_ent lst_pt)
   (setq
     dxf_ent (entget ent)
     lst_pt  (mapcar
	'(lambda (x) (trans x ent 0))
	(mapcar
	  'cdr
	  (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
	)
      )
   )
   (if	(= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
     (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
   )

   (if	(equal (car lst_pt) (last lst_pt) 1e-9)
     (vla-addDimAngular
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr (reverse lst_pt)))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (car lst_pt)
    (angle
      (car lst_pt)
      (mapcar '*
	      (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
	      '(0.5 0.5 0.5)
      )
    )
    (* 10 (getvar "DIMTXT"))
  )
)
     )
   )
   (while (cdr lst_pt)
     (vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (mapcar '*
	    (mapcar '+ (car lst_pt) (cadr lst_pt))
	    '(0.5 0.5 0.5)
    )
    (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
    (* 10 (getvar "DIMTXT"))
  )
)
     )
     (setq lst_pt (cdr lst_pt))
   )
 )


 ;; Programme principal
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
      (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (princ
   "\nSelectionner les Polylignes 2D (LWPline) a coter ... "
 )

 (if (setq js (ssget '((0 . "LWPOLYLINE"))))
   (ssmap 'Lw_Dim js)
 )
 (prin1)
)

 

A+ VDH-Bruno

Apprendre => Prendre => Rendre

Link to post
Share on other sites

Bonjour Patrice

 

Rapidement ceci devrait convenir:

;; 01/09/2020 variante de la Routine LW_DIM par GC
;; pour coter "plusieures" polyligne "legere" en mode ALIGNE 
;; Avec le style de Cotation COURANT
(defun c:nLw_Dim (/ js Lw_Dim ssmap AcDoc Space)


 ;; Fonctions auxiliaire
 (defun ssmap (fun ss / n)
   (if	(= 'PICKSET (type ss))
     (repeat (setq n (sslength ss))
(apply fun (list (ssname ss (setq n (1- n)))))
     )
   )
 )

 (defun Lw_Dim	(ent / dxf_ent lst_pt)
   (setq
     dxf_ent (entget ent)
     lst_pt  (mapcar
	'(lambda (x) (trans x ent 0))
	(mapcar
	  'cdr
	  (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
	)
      )
   )
   (if	(= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
     (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
   )

   (if	(equal (car lst_pt) (last lst_pt) 1e-9)
     (vla-addDimAngular
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr (reverse lst_pt)))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (car lst_pt)
    (angle
      (car lst_pt)
      (mapcar '*
	      (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
	      '(0.5 0.5 0.5)
      )
    )
    (* 10 (getvar "DIMTXT"))
  )
)
     )
   )
   (while (cdr lst_pt)
     (vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (mapcar '*
	    (mapcar '+ (car lst_pt) (cadr lst_pt))
	    '(0.5 0.5 0.5)
    )
    (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
    (* 10 (getvar "DIMTXT"))
  )
)
     )
     (setq lst_pt (cdr lst_pt))
   )
 )


 ;; Programme principal
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
      (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 )
 (princ
   "\nSelectionner les Polylignes 2D (LWPline) a coter ... "
 )

 (if (setq js (ssget '((0 . "LWPOLYLINE"))))
   (ssmap 'Lw_Dim js)
 )
 (prin1)
)

 

A+ VDH-Bruno

 

 

Je ne comprends pas la modification apportée, enfin ce qu'elle permet

Link to post
Share on other sites

Je ne comprends pas la modification apportée, enfin ce qu'elle permet

 

Si tu charges et exécutes nLw_Dim tu as une sélection plus large et tu peux traiter plusieurs polylignes en une commande,

avec Lw_Dim la première version postée par Patrice tu sélectionnes et traites une unique polyligne

Apprendre => Prendre => Rendre

Link to post
Share on other sites

Hello Drault & Bruno

 

Merci Bruno !

 

Donc voici la version (Routine : "nLw_Dim__v2")

qui genere des Cotes ALIGNEES ET ANGULAIRES sur N Polylignes 2D (LWPlines) ...

 

---- Pour Bruno : la routine de Gilles (Cotes alignees seulement) a un Micro-Bug !

---- Elle genere UNE Cote angulaire (Au vertex 1) si la Polyligne est Close !

---- Avec mon niveau 0.1 en Lisp, je ne sais pas du tout corriger ce Micro-Bug !

 

---- A priori c corrige ! Voir mon message suivant ...

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 


;; 
;; 01/09/2020 variante de la Routine LW_DIM par GC
;; Amelioration par VDH-Bruno 
;; Pour coter N Polylignes "legeres" (et non pas UNE Seule) 
;; ---- en mode ALIGNE + en mode ANGULAIRE ---- 
;; Avec le style de Cotation COURANT 
;; 

;(defun c:nLw_Dim__v2 (/ js Lw_Dim   ssmap AcDoc Space)
(defun c:nLw_Dim__v2 (/ js Lw_Dim_2 ssmap AcDoc Space)

 ;; Fonctions auxiliaire
 (defun ssmap (fun ss / n)
   (if	(= 'PICKSET (type ss))
     (repeat (setq n (sslength ss))
(apply fun (list (ssname ss (setq n (1- n)))))
     )
   )
 )

; (defun Lw_Dim  	(ent / dxf_ent lst_pt)
 (defun Lw_Dim_2	(ent / dxf_ent lst_pt)
   (setq
     dxf_ent (entget ent)
     lst_pt  (mapcar
	'(lambda (x) (trans x ent 0))
	(mapcar
	  'cdr
	  (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
	)
      )
   )
   (if	(= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
     (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
   )

   (if	(equal (car lst_pt) (last lst_pt) 1e-9)
     (vla-addDimAngular
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr (reverse lst_pt)))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (car lst_pt)
    (angle
      (car lst_pt)
      (mapcar '*
	      (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
	      '(0.5 0.5 0.5)
      )
    )
    (* 10 (getvar "DIMTXT")) 
  )
)
     )
   ) 

   (while (cdr lst_pt)
     (vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (mapcar '*
	    (mapcar '+ (car lst_pt) (cadr lst_pt))
	    '(0.5 0.5 0.5)
    )
    (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
    (* 10 (getvar "DIMTXT"))
  )
)
     )


(if (cddr lst_pt)
(vla-addDimAngular
Space
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point (car lst_pt))
(vlax-3d-point (caddr lst_pt))
(vlax-3d-point
(polar
(cadr lst_pt)
(angle
(cadr lst_pt)
(mapcar '*
(mapcar '+ (caddr lst_pt) (car lst_pt))
'(0.5 0.5 0.5)
)
)
(* 10 (getvar "DIMTXT"))
)
)
)

)


     (setq lst_pt (cdr lst_pt))
   )
 )


 ;; Programme principal 

 (vl-load-com) 

 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
      (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 ) 

 (princ
   "\Generation de N Cotations alignees + angulaires \nSelectionner les Polylignes 2D (LWPline) a coter ... "
 )

 (if (setq js (ssget '((0 . "LWPOLYLINE"))))
;;  (ssmap 'Lw_Dim    js) 
   (ssmap 'Lw_Dim_2  js) 

 )
 (prin1)
) 

Autodesk Expert Elite Team

Link to post
Share on other sites

Hello

 

Youpee j ai commente les lignes de la routine qui generaient potentiellement UNE Cote angulaire !?

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

 

;;
;; 01/09/2020 variante de la Routine LW_DIM par GC
;; https://cadxp.com/topic/49272-lisp-cotation/page__pid__295695
;; Amelioration par VDH-Bruno 
;; Pour coter N Polylignes "legeres" (et non pas UNE Seule) en mode ALIGNE 
;; Avec le style de Cotation COURANT 
;; 
;; Micro-Bug : si PLines Closes alors generation de UNE Cotation Angulaire sur le Vertex 1 !
;; Micro-Bug : corrige ... N lignes en commentaires ! 
;; 

(defun c:nLw_Dim__v1 (/ js Lw_Dim_1 ssmap AcDoc Space)


 ;; Fonctions auxiliaire
 (defun ssmap (fun ss / n)
   (if	(= 'PICKSET (type ss))
     (repeat (setq n (sslength ss))
(apply fun (list (ssname ss (setq n (1- n)))))
     )
   )
 )

 (defun Lw_Dim_1	(ent / dxf_ent lst_pt)
   (setq
     dxf_ent (entget ent)
     lst_pt  (mapcar
	'(lambda (x) (trans x ent 0))
	(mapcar
	  'cdr
	  (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)
	)
      )
   )
   (if	(= 1 (logand 1 (cdr (assoc 70 dxf_ent))))
     (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt))))
   )

;    (if	(equal (car lst_pt) (last lst_pt) 1e-9)
;      (vla-addDimAngular
;	Space
;	(vlax-3d-point (car lst_pt))
;	(vlax-3d-point (cadr (reverse lst_pt)))
;	(vlax-3d-point (cadr lst_pt))
;	(vlax-3d-point
;	  (polar
;	    (car lst_pt)
;	    (angle
;	      (car lst_pt)
;	      (mapcar '*
;		      (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt))
;		      '(0.5 0.5 0.5)
;	      )
;	    )
;	    (* 10 (getvar "DIMTXT")) 
;	  )
;	)
;       )
;    ) 

   (while (cdr lst_pt)
     (vla-addDimAligned
Space
(vlax-3d-point (car lst_pt))
(vlax-3d-point (cadr lst_pt))
(vlax-3d-point
  (polar
    (mapcar '*
	    (mapcar '+ (car lst_pt) (cadr lst_pt))
	    '(0.5 0.5 0.5)
    )
    (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5))
    (* 10 (getvar "DIMTXT"))
  )
)
     )
     (setq lst_pt (cdr lst_pt))
   )
 )


 ;; Programme principal 

 (vl-load-com) 

 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
      (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
 ) 

 (princ
   "\Generation de N Cotations alignees \nSelectionner les Polylignes 2D (LWPline) a coter ... "
 )

 (if (setq js (ssget '((0 . "LWPOLYLINE")))) 

;;  (ssmap 'Lw_Dim   js) 
   (ssmap 'Lw_Dim_1 js) 

 )
 (prin1)
) 

Autodesk Expert Elite Team

Link to post
Share on other sites

Donc voici la version (Routine : "nLw_Dim__v2")

Grand bravo pour l'adaptation :)

 

Youpee j ai commente les lignes de la routine qui generaient potentiellement UNE Cote angulaire !?

Re grand bravo :)

 

Le lisp peut être une idée à creuser pour la suite avenir ;)

A+ Bruno

Apprendre => Prendre => Rendre

Link to post
Share on other sites
  • 7 months later...

Bonjour,

 

je relance le sujet dans l'espoir, cette fois-ci, de trouver un LISP permettant de côté à des pièces, quelles soient biscornues ou pas, et si possible si plusieurs pièces sont mitoyennes, que les côtes s'alignent.

 

Avez-vous un lien vers un lisp déjà existant ?

 

Merci et belle journée,

Link to post
Share on other sites

Super mais non.

D'abord, je ne connais pas bien le VBA mais cela pourrait m'intéresser en plus de ta commande présente.

Ma question portait plus un equivalent du LISP proposé par leCrabe/VDH-Bruno ou autrement dit après lancé une commande et sectionné une PO, les "grandes côtes" ou l'ensemble des côtes se mettent au centre;

Si possible, je cherche à ce que je puisse faire des réglages au sein d'une fenêtre, car le code, ce n'est pas encore cela pour moi....

 

Merci

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...