Lisp Epaisseur de trait

[Kevin_Megel]

Hello la communauté,

j'ai besoin de pouvoir tout selectionner les objets de l'espace objet ( juste de l'espace objet) pour leur mettre à tous la même epaisseur de trait.

il faut bien entendu la même chose pour les bloc donc je me suis dit que je pourrais passer par une lisp, et j'ai tenté l'aventure.

Pour le pas faire trop compliqué avant de pourvoir entré dans les bloc sans les exploser, je me suis dit que je vais déjà trouver comment tout selectionné sur l'espace objet et lancer la variable, et la je coince déjà, ça doit déjà faire sourir les pro du lisp, et je vais balancer le code que j'ai tenté de faire, et la ils vons exploser de rire....

(defun c: EPT
  (ssget "_X" ' ((0 . "ModelSpace"))
	 (command "_EPAISSLIGN")
	 )
  )

Bon avant tout j'aimerais avant que l'un d'entre vous me sorte la lisp toute faite, comprendre comment on fait et ou sont mes erreurs

J'ai peut être vue trop ambitieux pour une première ?

[_gile]

---

Megeon a écrit :

pour récupérer la liste j'ai donc

  (setq ss (ssget "_X" '((0 . "INSERT")))
	

---

Il manque une parenthèse fermante...

Ensuite, il faut comprendre comment fonctionne while.

(while condition [expression ...])

tant que condition ne sera pas nil, [expression ...] sera exécuté.

Ici condition = (setq ent (ssname ss n))

ssname retournera nil si'il n'y a pas d'entité à l'index spécifié (ex : si ss contient 5 éléments (indices 0 1 2 3 4) et que n est égal à 5).

Pour que la boucle s'arrête, il faut donc incrémenter n à chaque itération.

Et à chaque itération, on décompose l'entité ent.

Tu y es presque...

[Anonymous]

Ca patauge un peu donc je te donner des indications plus précise.

j'ai toujours le même probleme de parenthèse

(setq ss (ssget "_X" '((0 . "INSERT")))

As tu testé cette ligne seule dans l'éditeur visual lisp ?

Sinon, sans tester le code, 2 manières de vérifier tes parenthèses :

1- Lorsque tu fermes une parenthèse dans l'éditeur , la parenthèse ouvrante correspondante clignote.

2- Un double clic avant une parenthèse ouvrante ou après une parenthèse fermante te permettrant de mettre en surbrillance la partie consernée.

Olivier

PS : Je me suis fais grillé par Gilles.

(petite subtilité, il faut valider la sélection quand on passe un ename à command) J'ai testé et ce n'est pas nécessaire avec un ename, uniquement avec une sélection.

[Kevin_Megel]

pioufff réussi

(defun c:EA (/ n ss ent)
  (setq n 0)
  (setq ss (ssget "_X" '((0 . "INSERT"))))
	(while
	  (setq ent (ssname ss n))
	  (setq n (1+ n))
	  (command "_EXPLODE" ent "")
	  )
  (princ)
  )

j'insistait pour fermer la parenthese de seqt ss apres avoir inclut le (while...)

Merci Gilles, et Olivier

 Edit: je vien a peine de voir ton message Olivier, merci quand même

Je vien de passer pas loin de 2 semaine sur se code de 10 lignes  y a encore du boulot

[Kevin_Megel]

bonjour a tous,

tjours pour évité d'ouvrir un nième sujet sur les lisps je continue ici

donc, j'ai fait un pti progamme qui me permet de tout selectionner et de tout mettre sur le calcque 0 ( et de purger)

(defun c:ALCL ()
(command "_change" "_all" "" "p" "_la" "0" "")
(command "_-purge" "_all" "" "n")
(princ)
)

 ça m'est utile quand je reçois des fichier extern de ne pas me retrouver avec 12000 calque que je n'utilise pas.

par contre ça prend tout les claques et j'aimerait bien pouvoir juste selectionner les calque que j'ai besoin (et avoir une option pour tout selectionner)

et la je suis perdu

vous auriez des piste a m'indiquer ?

[Anonymous]

Bonjour Megeon,

En utilisant la routine GETLAYERS de Gilles, tu auras déjà un point de départ.

                          Au passage, merci Gilles pour cette routine dont je me suis plusieurs fois servis.

Olivier

[Kevin_Megel]

merci je vais jetter un oeil.

[Kevin_Megel]

bon j'ai trouver la routine ( pas trop compliqué), mais je ne vois pas commen l'exploiter

[Kevin_Megel]

hello j'ai téléchargé le lisp CurveText, et Autacad mac me dit qu'il ne peut pas le charger, ma question est qu'est ce qui ne passe pas sur AcadMAC ?

Je précise que je cherche un équivalent pour ACADMAC sur leur forum

[_gile]

salut,

Je ne connais pas ce LISP "CurveText" et ne sais pas non plus où tu l'as téléchargé, mais je sais qu'AutoCAD MAC a des (grosses) lacunes par rapport à AutoCAD windows, notamment en terme personnalisation/programmation.

AutoCAD MAC ne supporte que la programmation AutoLISP et ObjectARX/C++.

Il ne supporte donc pas les interfaces COM/ActiveX et .NET, donc concernant COM, il ne supporte ni le VBA ni le Visual LISP (entendons par là la partie LISP qui utilise l'interface COM, voir ici).

[Kevin_Megel]

je l'ai télécharger hier soir sur je ne sais plus quel site, mais si tu veux le voir

;;; [c]2004 Andrzej Gumula, Katowice, Poland
;;; This routine creates curve text
;;; Accept control codes - degree, tolerance and diameter symbol
;;; Curve - for example a line, arc, circle, polyline, ellipse or spline, also entity of block (xref)
;;; Note - for knowledge, the routine always draw temporary circle at the beginning of the curve
;;; Please see CurveTextHelp.dwg file for help
;;; Files - CurveText.lsp, CurveText.dcl, CurveText.slb

(vl-load-com)

(defun c:CurveText ( / TxtPath TxtString TxtStart TxtPoint TxtChar TxtAngle TxtDir
                       CurvePoint LengthObj Flag Tmp Charwidth StartPt PickPoint
		       OldVars Olderr TmpObjectStart TmpObject CurveTxtHeight TxtStyle WhatNext
		       Id Fit x y)

(defun LispError (It)
 (if OldErr (setq *error* OldErr))
 (prompt (strcat "\nError: " (strcase It) "\n"))
 (if TmpObject (entdel TmpObject))
 (if TmpObjStart (entdel TmpObjStart))
 (if TxtPath (vla-highlight TxtPath 0))
 (vl-cmdf "_.undo" "_end")
 (mapcar 'setvar '("cmdecho" "highlight" "dimzin" "osmode") OldVars)
 (princ)
);end LispError

(defun CreateText (/ StringLength Item IndexChar TmpOffset TxtSet)
(while (/= TxtString (setq TxtString (vl-string-subst "" "%%u" TxtString))))
(while (/= TxtString (setq TxtString (vl-string-subst "" "%%U" TxtString))))
(while (/= TxtString (setq TxtString (vl-string-subst "" "%%o" TxtString))))
(while (/= TxtString (setq TxtString (vl-string-subst "" "%%O" TxtString))))
(if (minusp CurveTxtOffset) (setq CurveTxtOffset (- CurveTxtOffset CurveTxtHeight)))
(if (= TxtDir "1") (setq CurveTxtOffset (+ CurveTxtOffset CurveTxtHeight)))
(if (= TxtDir "1")
(setq Item (strlen TxtString) IndexChar -1)
(setq Item 1 IndexChar 1)
)
(cond
((= TxtStart "Middle") 
 (setq StringLength (* 0.5 (- LengthObj (TakeTmpWidth TxtString CurveTxtWidth))) 
 )
)
((= TxtStart "End")
 (setq StringLength (- LengthObj (TakeTmpWidth TxtString CurveTxtWidth))
 )
)
((and (= TxtStart "Pick") (= TxtOrient "End")) 
 (setq StringLength (vlax-curve-getDistAtPoint 
                     TxtPath 
                    (vlax-curve-getClosestPointTo TxtPath (trans PickPoint 1 0))
                   )
 )
)
((and (= TxtStart "Pick") (= TxtOrient "Begin")) 
 (setq StringLength (- (vlax-curve-getDistAtPoint 
                      TxtPath 
                      (vlax-curve-getClosestPointTo TxtPath (trans PickPoint 1 0))
                      )
                      (TakeTmpWidth TxtString CurveTxtWidth)
                   )

 )
)
(T (setq StringLength 0.0))
);end cond

(setq StringLength (+ (* 0.5 (TakeTmpWidth (substr TxtString Item 1) CurveTxtWidth))
                      StringLength
                   )
)
(repeat (strlen TxtString)
(cond
 ((and (= 1 IndexChar) (member (strcase (substr TxtString Item 3)) '("%%C" "%%D" "%%P" "%%%")))
  (setq TxtChar (substr TxtString Item 3))
  (setq Item (+ Item IndexChar))
  (setq Item (+ Item IndexChar))
 )
 ((and (= -1 IndexChar) (> Item 2 ) (member (strcase (substr TxtString (- Item 2) 3)) '("%%C" "%%D" "%%P" "%%%")))
  (setq TxtChar (substr TxtString (- Item 2) 3))
  (setq Item (+ Item IndexChar))
  (setq Item (+ Item IndexChar))
 )
 ((> Item 0) (setq TxtChar (substr TxtString Item 1)))
)
(Evaluation CharWidth)
(entmake (list '(0 . "TEXT") (cons 1 TxtChar) '(72 . 1) (cons 10 TxtPoint) (cons 7 (getvar "TEXTSTYLE"))
                (cons 11 TxtPoint) (cons 40 CurveTxtHeight) (cons 41 CurveTxtWidth)
                (cond ((= TxtDir "0") (cons 50 TxtAngle)) 
                      (T (cons 50 (- TxtAngle pi)))
                )
         )
)
(cond
 ((not TxtSet)  (setq TxtSet (ssadd (entlast))))
 (T (CorrectPos (entlast) (ssname TxtSet (1- (sslength TxtSet)))) (ssadd (entlast) TxtSet))
)
(setq Item (+ Item IndexChar))
(if (and (> Item 0) (<= Item (strlen TxtString)))
(setq StringLength 
 (+ StringLength 
  (setq CharWidth
   (if (minusp IndexChar) 
    (TakeTrueWidth (substr TxtString Item 1))
    (TakeTrueWidth TxtChar)
   )
  )
 )
)
);end if
);end repeat
(vl-cmdf "_.-group" "" (menucmd "M=$(edtime,$(getvar,date),D_MONTH_YY_HH_MM_SS)") "CurveTxt" TxtSet "")
);end CreateText


(defun XCopy (Elem / Matrix TMtx)
  (if (entmake (entget (car Elem)))
   (progn
   (setq Matrix (caddr Elem)
         TMtx (list (list (car (nth 0 Matrix)) (car (nth 1 Matrix)) (car (nth 2 Matrix)) (car (nth 3 matrix)))
		       (list (cadr (nth 0 Matrix)) (cadr (nth 1 Matrix)) (cadr (nth 2 Matrix)) (cadr (nth 3 matrix)))
		       (list (caddr (nth 0 Matrix)) (caddr (nth 1 Matrix)) (caddr (nth 2 Matrix)) (caddr (nth 3 matrix)))
		       '(0.0 0.0 0.0 1.0)))
   (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-transformby (list (vlax-ename->vla-object (setq TmpObject (entlast))) (vlax-tmatrix TMtx))))
    (progn
     (entdel TmpObject)
     (setq TmpObject (prompt "\nSubentity with different X, Y scales. Please select another..."))
     (setq Check nil)
    )
   );end if
   )
  );end if
);end XCopy

(defun Dxf (Index IdElem)
 (cdr (assoc Index (entget IdElem)))
);end Dxf

 (defun ReactionButton (Reactor Pt)
  (setq Check T)
 );end ReactionButtom

(defun SelectObj (/ Object)
 (setq Check nil
       MouseReactor (VLR-Mouse-Reactor nil '((:VLR-beginRightClick . ReactionButton))))
 (while (not Check)
  (if (setq Object (nentsel "\nSelect entity (pick right button mouse to cancel command): "))
   (setq Check (member  (Dxf 0 (car Object)) '("POLYLINE" "LWPOLYLINE" "CIRCLE" "LINE" "ARC" "SPLINE" "ELLIPSE")))
  )
  (if (and Object (not Check)) 
   (prompt "\nPlease select line, arc, circle, polyline, ellipse or spline. ")
  )
  (if (> (length Object) 2)
   (Xcopy Object)
  );end if
 );end while
 (vlr-remove MouseReactor)
 (setq MouseReactor nil)
 (if (equal Check T)
  nil
  (progn
   (setq PickPoint (cadr Object))
   (if (> (length Object) 2)
    (vlax-ename->vla-object (entlast))
    (vlax-ename->vla-object (car Object))
   );end if
  )
 );end if
);end SelectObj

(defun TakeTmpWidth (Text Width / TxtBox) 
 (setq TxtBox 
  (textbox 
   (list (cons 1 Text) (cons 7 (getvar "TEXTSTYLE")) (cons 40 (if (numberp CurveTxtHeight) CurveTxtHeight (atof CurveTxtHeight))) 
         (cons 41 Width) '(50 . 0.0)
   )
  )
 )
 (- (caadr TxtBox) (caar TxtBox))
);end TmpWidth

(defun TakeTrueWidth (StrChar)
 (- (TakeTmpWidth (strcat "a" StrChar "a") CurveTxtWidth)
    (TakeTmpWidth "aa" CurveTxtWidth)
 )
);end TakeWidth

(defun CalculateWidth (Value)
 (cond
 ((= Value "1")
  (setq TxtStart "Begin")
  (set_tile "Begin" "1")
  (setq TxtOrient "End")
  (set_tile "ToEnd" "1")
  (mapcar 'mode_tile '("Pick" "Begin" "End" "Middle" "Width") '(1 1 1 1 1))
  
  (if (< (strlen TxtString) 3)
  (progn
   (mode_tile "accept" 1)
   (Error "In fit mode, user should enter at least 3 chars of text. " Key)
  )
  (progn
  (set_tile "Width" (setq CurveTxtWidth (R2S (/ LengthObj (TakeTmpWidth TxtString 1.0)))))
  (mode_tile "accept" 0)
  )
  );end if
   "1"
 )
 (T
  (mapcar 'mode_tile '("Pick" "Begin" "End" "Middle" "Width") '(0 0 0 0 0))
  "0"
 )
 );end cond
);end CalculateWidth

(defun TakeDeriv (Param)
 (angle '(0.0 0.0 0.0) 
         (vlax-curve-getFirstDeriv TxtPath Param)
 )
);end TakeDeriv

(defun GetStyles (/ StylesList Style)
(while (setq Style (tblnext "STYLE" (not Style)))
(if (equal 0 (logand 0 (cdr (assoc 70 Style))))
(setq StylesList (cons (cdr (assoc 2 Style)) StylesList))
);end if
);end while
(acad_strlsort StylesList)
);end GetStyles

(defun Evaluation (Add)
(cond
((and (>= StringLength 0) (>= LengthObj StringLength))
(setq TxtAngle (TakeDeriv (vlax-curve-getParamAtDist TxtPath StringLength))
      CurvePoint (vlax-curve-getPointAtDist TxtPath StringLength)
)
)
((minusp StringLength)
(setq TxtAngle (TakeDeriv (vlax-curve-getStartParam TxtPath))
      CurvePoint
      (cond
      ((not CurvePoint) (polar StartPt TxtAngle StringLength))
      (T (polar CurvePoint TxtAngle Add))
      )
)
)
(T 
(setq TxtAngle (TakeDeriv (vlax-curve-getEndParam TxtPath))
      CurvePoint (polar CurvePoint TxtAngle Add)
)
)
);end cond
(setq TxtPoint (polar CurvePoint (+ TxtAngle (/ pi 2)) CurveTxtOffset))
);end Evaluation

(defun CorrectPos (Current Prev / Old New CorrectDist)
(setq Old (entget Current)
      CorrectDist (- (distance (Dxf 11 Current) (Dxf 10 Current))
                     (distance (Dxf 11 Prev) (Dxf 10 Prev))
                  )
)
(if (= TxtDir "1") (setq CorrectDist (- CorrectDist)))
(setq  StringLength (+ StringLength CorrectDist))
(Evaluation CorrectDist)

(setq New (subst (cond ((= TxtDir "0") (cons 50 TxtAngle)) 
                       (T (cons 50 (- TxtAngle pi)))
                 )
                  (assoc 50 Old) Old
          )
)
(entmod (subst (cons 11 TxtPoint) (assoc 11 New) New))
);end CorrectPos

(defun R2S (Value)
(rtos Value (getvar "LUNITS") (getvar "LUPREC"))
);end R2S

(defun Error (Msg Key)
(set_tile "error" Msg)
(mode_tile Key 2)
(mode_tile Key 3)
nil
);end Error

(defun CheckValue (Value Key)
    (cond
     ((or (and (distof Value) (> (distof Value) 0.0)) (and (distof Value) (= Key "Offset")))
      (set_tile "error" "")
      (set_tile Key (R2S (distof Value)))
      (R2S (distof Value))
     )
     ((and (distof Value) (<= (distof Value) 0.0))
      (Error "Please enter a positive number. " Key)
     )
     (T (Error "Please enter a number. " Key))
    );end cond 
);end CheckValue

(defun CheckTxt (Value Key)
(if (= (setq TxtString (vl-string-trim " " Value)) "") (mode_tile "accept" 1) (mode_tile "accept" 0))
(if (= Fit "1") (CalculateWidth Fit))
(if (and (< (strlen TxtString) 3) (= Fit "1"))
  (progn
   (mode_tile "accept" 1)
   (Error "In fit mode, user should enter at least 3 chars of text. " Key)
  )
  (progn
   (mode_tile "accept" 0)
   (set_tile "error" "")
  )
);end if
(if (> (strlen TxtString) 2)
  (progn 
   (mode_tile "Fit" 0)
   ;;(set_tile "Fit" "0")
  )
  (progn
    (mode_tile "Fit" 1)
  )
);end if
);CheckTxt

(defun ShowImage ()
 (if (= TxtStart "Pick")
   (mapcar 'mode_tile '("ToEnd" "ToBegin") '(0 0))
   (mapcar 'mode_tile '("ToEnd" "ToBegin") '(1 1))
 );end if
 (start_image "Image")
 (fill_image 0 0 x y -15)
 (cond
  ((and (= TxtDir "0") (>= (atof CurveTxtOffset) 0.0) (= Fit "1"))
   (slide_image 0 0 x y "CurveText(13)")
  )
  ((and (= TxtDir "0") (< (atof CurveTxtOffset) 0.0) (= Fit "1"))
   (slide_image 0 0 x y "CurveText(14)")
  )
  ((and (= TxtDir "1") (>= (atof CurveTxtOffset) 0.0) (= Fit "1"))
   (slide_image 0 0 x y "CurveText(15)")
  )
  ((and (= TxtDir "1") (< (atof CurveTxtOffset) 0.0) (= Fit "1"))
   (slide_image 0 0 x y "CurveText(16)")
  )
  ((and (= TxtDir "0") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Middle"))
   (slide_image 0 0 x y "CurveText(1)")
  )
  ((and (= TxtDir "0") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Middle"))
   (slide_image 0 0 x y "CurveText(2)")
  )
  ((and (= TxtDir "1") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Middle"))
   (slide_image 0 0 x y "CurveText(3)")
  )
  ((and (= TxtDir "1") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Middle"))
   (slide_image 0 0 x y "CurveText(4)")
  )
  ((and (= TxtDir "0") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Begin"))
   (slide_image 0 0 x y "CurveText(5)")
  )
  ((and (= TxtDir "0") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Begin"))
   (slide_image 0 0 x y "CurveText(6)")
  )
  ((and (= TxtDir "1") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Begin"))
   (slide_image 0 0 x y "CurveText(7)")
  )
  ((and (= TxtDir "1") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Begin"))
   (slide_image 0 0 x y "CurveText(8)")
  )
  ((and (= TxtDir "0") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "End"))
   (slide_image 0 0 x y "CurveText(9)")
  )
  ((and (= TxtDir "0") (< (atof CurveTxtOffset) 0.0) (= TxtStart "End"))
   (slide_image 0 0 x y "CurveText(10)")
  )
  ((and (= TxtDir "1") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "End"))
   (slide_image 0 0 x y "CurveText(11)")
  )
  ((and (= TxtDir "1") (< (atof CurveTxtOffset) 0.0) (= TxtStart "End"))
   (slide_image 0 0 x y "CurveText(12)")
  )
  ((and (= TxtDir "0") (= TxtOrient "End") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(17)")
  )
  ((and (= TxtDir "0") (= TxtOrient "End") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(18)")
  )
  ((and (= TxtDir "1") (= TxtOrient "End") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(19)")
  )
  ((and (= TxtDir "1") (= TxtOrient "End") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(20)")
  )

  ((and (= TxtDir "0") (= TxtOrient "Begin") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(21)")
  )
  ((and (= TxtDir "0") (= TxtOrient "Begin") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(22)")
  )
  ((and (= TxtDir "1") (= TxtOrient "Begin") (>= (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(23)")
  )
  ((and (= TxtDir "1") (= TxtOrient "Begin") (< (atof CurveTxtOffset) 0.0) (= TxtStart "Pick"))
   (slide_image 0 0 x y "CurveText(24)")
  )
 );end cond
 (end_image)
);end ShowImage

(setq OldErr *error* *error* LispError)
(setq OldVars (mapcar 'getvar '("cmdecho" "highlight" "dimzin" "osmode")))
(mapcar 'setvar '("cmdecho" "highlight" "dimzin" "osmode") '(0 1 0 0))
(vl-cmdf "_.undo" "_be")

(cond
((setq TxtPath (SelectObj))
 (setq StartPt (vlax-curve-getStartPoint TxtPath)
       LengthObj (vlax-curve-getDistAtParam TxtPath (vlax-curve-getEndParam TxtPath))
 )
 (entmake (list '(0 . "CIRCLE") (cons 10 StartPt)
                 (cons 40 (/ (getvar "VIEWSIZE") 100.0)) (cons 62 (vla-get-color TxtPath))
          )
 )
 (setq TmpObjStart (entlast))
 (vla-highlight TxtPath 1)
 (princ)
 (setq TxtString "")

 (setq CurveTxtHeight (R2S (getvar "TEXTSIZE")))
 (if (or (not CurveTxtWidth) (not (numberp CurveTxtWidth)) (<= CurveTxtWidth 0.0))
  (setq CurveTxtWidth (R2S 1.0))
  (setq CurveTxtWidth (R2S CurveTxtWidth))
 );end if
 (if (or (not CurveTxtOffset) (not (numberp CurveTxtOffset)))
  (setq CurveTxtOffset (R2S 0.0))
  (setq CurveTxtOffset (R2S CurveTxtOffset))
 );end if
 (setq TxtStyle (getvar "TEXTSTYLE")
       TxtStart "Middle"
       TxtDir "0"
       TxtOrient "End")
 (setq Id (load_dialog "CurveText"))
 (if (not (new_dialog "CURVETEXT" Id))
  (progn
    (alert "Cannot open CurveText.dcl file. ")
    (exit)
  )
 );end if
 (if (not (findfile "CurveText.slb"))
   (alert "Cannot find CurveText.slb file.\nThis file is necessary to correct display of dialog window.")
 );end if
 (mapcar 'set_tile '("error" "Text" "Height" "Width" "Offset" "TxtStyle")
                    (list "" TxtString CurveTxtHeight CurveTxtWidth CurveTxtOffset (strcat "Current style text: " TxtStyle)))
 (if (= (vl-string-trim " " TxtString) "") (mode_tile "accept" 1) (mode_tile "accept" 0))
 (setq x (dimx_tile "Image")
       y (dimy_tile "Image"))
 (start_image "Image")
 (fill_image 0 0 x y -15)
 (slide_image 0 0 x y "CurveText(1)")
 (end_image)
 (start_list "Styles")
 (mapcar 'add_list (GetStyles))
 (end_list)

 (action_tile "Text"  "(CheckTxt (get_tile $key) $key)")
 (action_tile "Offset"  "(setq CurveTxtOffset (CheckValue (get_tile $key) $key)) (ShowImage)")
 (action_tile "Height"  "(setq CurveTxtHeight (CheckValue (get_tile $key) $key)) (CalculateWidth Fit)")
 (action_tile "Width"  "(setq CurveTxtWidth (CheckValue (get_tile $key) $key))")
 (action_tile "Styles" "(set_tile \"TxtStyle\" (strcat \"Current style text: \" (setq TxtStyle (nth (atoi $value) (GetStyles)))))")
 (action_tile "Pick" "(setq TxtStart \"Pick\") (ShowImage)")
 (action_tile "Begin" "(setq TxtStart \"Begin\") (ShowImage)")
 (action_tile "End" "(setq TxtStart \"End\") (ShowImage)")
 (action_tile "Middle" "(setq TxtStart \"Middle\") (ShowImage)")
 (action_tile "ToEnd" "(setq TxtOrient \"End\") (ShowImage)")
 (action_tile "ToBegin" "(setq TxtOrient \"Begin\") (ShowImage)")
 (action_tile "Reverse" "(setq TxtDir $value) (ShowImage)")
 (action_tile "Fit" "(setq Fit (CalculateWidth $value)) (ShowImage)")
 (action_tile "accept" "(done_dialog 1)")
 (action_tile "cancel" "(done_dialog 0)")
 (setq WhatNext (start_dialog))

 (cond
 ((= WhatNext 1)	
 (setvar "TEXTSTYLE" TxtStyle)
 (setvar "TEXTSIZE" (setq CurveTxtHeight (atof CurveTxtHeight)))
 (setq CurveTxtWidth (atof CurveTxtWidth)) 
 (setq CurveTxtOffset (atof CurveTxtOffset))
 (done_dialog 1)
 (unload_dialog Id)
 (CreateText)
 )
 ((= WhatNext 0)
 (prompt "\nCommand canceled. ")
 ) 
 );end cond
 (vla-highlight TxtPath 0)
 (if TmpObjStart (entdel TmpObjStart))
 (if TmpObject (entdel TmpObject))
 )
);end cond
(setq *error* OldErr)
(vl-cmdf "_.undo" "_end")
(mapcar 'setvar '("cmdecho" "highlight" "dimzin" "osmode") OldVars)
(princ)
);end file

(prompt "\nLoaded new command CurveText. ")
(prompt "\n[c]2004 Andrzej Gumula. ")
(princ)

[_gile]

Ce LISP utilise des fonctions vlax-* qui ne sont pas disponible sur AutoCAD MAC.

[Kevin_Megel]

ok merci Gilles,

Maintenant je revien sur mon soucis de base,

j'ai donc la routine  recupéré "getlayers"

et je n'arrive pas a savoir comment l'utiliser, une piste ou deux pour l'utilisation des fonctions ? ou commen appeler une fonctions ?

[_gile]

Salut,

Comme expliqué dans Introduction à AutoLISP  -> Définition de fonctions (chapitre 6, page 15) : une fonction LISP définie avec (defun ...) s'utilise comme une fonction LISP native. On l'appelle en lui passant les arguments requis quand il en a.

Pour GetLayers, les arguments requis sont décrits dans les commentaires en en-tête :

;; arguments
;; titre : le titre de la boite de dialogue ou nil (defaut = Choisir les calques)
;; lst1 : la liste des calques à pré-cochés ou nil
;; lst2 : la liste des calques non cochables (grisés) ou nil

On peut donc appeler getLayers avec les 3 arguments à nil :

(getLayers nil nil nil)

pour ouvrir la boite de dialogue ave le tritre par défaut ("Choisir les calques") avec aucun claque précoché ni grisé.

On peut aussi spécifier un titre (ex: "Calques à geler") et précocher certains calques (ici seulement "0") :

(getLayers "Calques à geler" '("0") nil)

Ou encore griser certains calques (l'utilisateur ne pourra pas les cocher ou les décocher)

(getLayers "Calques à geler" '("0") '("0" "Defpoints"))

La fonction retourne une liste contenant les noms des calques cochés dans la boite de dialogue.

[Kevin_Megel]

bon je suis paumé,

lorsque j'ai fait la lisp pour explosé tout les blocs, j'ai appris que l'on pouvais metre une varaible dans la command

(command "_explode" ss "")

ce que je cherche a reproduire, j'ai donc cherché la commande pour changer le calque d'un objet et j'ai trouver "_change"

j'ai tester pour reprerer les commande

soit

commande : _change

1er : Selection

2 : Prorpiéter

3 : Calque

4 : Choix du calque

5 : Valider

se qui donne lorsque je selectionne tout pour mettre sur le calque 0 en Lisp

(Command "_change" "_all" "p" "_la" "0" "")

donc en changent le "_all" par le jeu de selection ça devrait aller, mais ça me dit commande inconnue. et je commence a tourné en rond, donc je suis perdu. pourquoi ça ne fonctionne pas

(command "_change" ss "" "p" "_la" "0" "")

a moins que ça ne viens du jeu de selection ?

(setq alcl (getlayers nil nil nil))
(setq ss (ssget "_X" '((8 . "alcl"))))

 mais je me dit que ça me dirrait que l'erreur viens de la, et non pas de la commande

[patrick_35]

Salut

Regarde les résultats, on expliquera plus tard les fonctions mapcar et apply

(setq alcl (getlayers nil nil nil))
(setq alcl (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) alcl)))
(setq alcl (substr alcl 1 (1- (strlen alcl))))
(setq ss (ssget "_X" (list (cons 8 alcl))))

 ps : non testé

@+

[Anonymous]

Bonjour Megeon,

Attention, ce que que renvoi une fonction. Je cite (gile) :

La fonction retourne une liste contenant les noms des calques cochés dans la boite de dialogue.

Hors toutes les fonctions que tu utilises nécessitent un nom de calque seul sous forme de string.

Olivier

[Kevin_Megel]

ça fonctionne merci bien Patrick

maintenant je vais me penché sur ces fonction et a quoi elle serve

@ Olivier : merci je suppose que ça a un rapport avec se que dit Patrick

[Kevin_Megel]

Si cela interesse

J'ai ajouté une purge a la fin aussi

;;; ALCL 
;;; Passe les entitées d'un calque sur le calque 0

(defun c:ALCL (/ getlayers sublist alcl ss)

;; GETLAYERS (gile) 02/12/07
;; Retourne la liste des calques cochés dans la boite de dialogue
;;
;; arguments
;; titre : le titre de la boite de dialogue ou nil (defaut = Choisir les calques)
;; lst1 : la liste des calques à pré-cochés ou nil
;; lst2 : la liste des calques non cochables (grisés) ou nil

(defun getlayers (titre	lst1 lst2 / toggle_column tmp file lay layers len dcl_id lst)

  (defun toggle_column (lst)
    (apply 'strcat
	   (mapcar
	     (function
	       (lambda (x)
		 (strcat ":toggle{key="
			 (vl-prin1-to-string x)
			 ";label="
			 (vl-prin1-to-string x)
			 ";}"
		 )
	       )
	     )
	     lst
	   )
    )
  )

  (setq	tmp  (vl-filename-mktemp "tmp.dcl")
	file (open tmp "w")
  )
  (while (setq lay (tblnext "LAYER" (not lay)))
    (setq layers (cons (cdr (assoc 2 lay)) layers))
  )
  (setq	layers (vl-sort layers '<)
	len    (length layers)
  )
  (write-line
    (strcat
      "GetLayers:dialog{label="
      (cond (titre (vl-prin1-to-string titre))
	    ("\"Choisir les calques\"")
      )
      ";:boxed_row{:column{"
      (cond
	((< len 12) (toggle_column layers))
	((< len 24)
	 (strcat (toggle_column (sublist layers 0 (/ len 2)))
		 "}:column{"
		 (toggle_column (sublist layers (/ len 2) nil))
	 )
	)
	((< len 45)
	 (strcat (toggle_column (sublist layers 0 (/ len 3)))
		 "}:column{"
		 (toggle_column (sublist layers (/ len 3) (/ len 3)))
		 "}:column{"
		 (toggle_column (sublist layers (* (/ len 3) 2) nil))
	 )
	)
	(T
	 (strcat (toggle_column (sublist layers 0 (/ len 4)))
		 "}:column{"
		 (toggle_column (sublist layers (/ len 4) (/ len 4)))
		 "}:column{"
		 (toggle_column (sublist layers (/ len 2) (/ len 4)))
		 "}:column{"
		 (toggle_column (sublist layers (* (/ len 4) 3) nil))
	 )
	)
      )
      "}}spacer;ok_cancel;}"
    )
    file
  )
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "GetLayers" dcl_id))
    (exit)
  )
  (foreach n lst1
    (set_tile n "1")
  )
  (foreach n lst2
    (mode_tile n 1)
  )
  (action_tile
    "accept"
    "(setq lst nil)
    (foreach n layers
    (if (= (get_tile n) \"1\")
    (setq lst (cons n lst))))
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  lst
)

;;; SUBLIST (gile)
;;; Retourne une sous-liste
;;;
;;; Arguments
;;; lst : une liste
;;; start : l'index de départ de la sous liste (premier élément = 0)
;;; leng : la longueur (nombre d'éléments) de la sous-liste (ou nil)
;;;
;;; Exemples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
  (if (or (not leng) (< (- (length lst) start) leng))
    (setq leng (- (length lst) start))
  )
  (setq n (+ start leng))
  (repeat leng
    (setq r (cons (nth (setq n (1- n)) lst) r))
  )
)

;;; Passage des entitées du calcque sur calque 0

  (setq alcl (getlayers nil nil nil))
  (setq alcl (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) alcl)))
  (setq alcl (substr alcl 1 (1- (strlen alcl))))
  (setq ss (ssget "_X" (list (cons 8 alcl))))
  (command "_change" ss "" "p" "_la" "0" "")
  (command "_purge" "_all" "" "n")
  (princ)
)

[patrick_35]

Salut C'est bien de poster le résultat de ses recherches, mais as-tu approfondit ce que je t'ai donné ? @+

[Kevin_Megel]

 pour apply et mapcar ?

oui j'ai approfondit, voila ce que j'ai comrpsi,  dite moi si j'ai juste ou pas

Apply, permet d'appilquer une fonction a une liste dans sa globalité

Mapcar permet d'appliquer une fonction a chaque element d'une liste