truecolor et odre de tracé

[draven]

Bonjour,

je débute en visual lisp et je voudrais transforer quelque uns de mes lisp

en V-lisp.

Est ce quelqu'un pour m'indiquer la voie à suivre comme pour ce lisp par exemple:

 

(defun c:H230 (/ ss )

(princ "-->Hachures en couleur RVB 230,230,230<--")

(princ "\nChoix des objets/[Entrée pour toutes les hachures]")

(if (setq ss (ssget '((0 . "HATCH"))))

(progn

(command "changer" ss "" "PR" "CO" "U" "230,230,230" "")

(command "ordretrace" ss "" "ar")

); fin de progn pour if : vrai

(progn

(setq ss (ssget "X" '((0 . "HATCH") )))

(if ss

(progn

(command "changer" ss "" "PR" "CO" "U" "230,230,230" "")

(command "ordretrace" ss "" "ar")

)

(alert "Il n'y a pas de hachure dans ce dessin")

)

); fin de progn pour if : faux

); fin de if

(princ)

)

 

merci d'avance pour vos réponses

[(gile)]

Salut,

 

Pour les couleurs (TrueColor), je te recommande de lire les routines fournies dans le dossier "Sample" (C:\Program Files\AutoCAD 200X\Sample\Visual LISP). Suivant les versions, ce dossier n'est pas installé par défaut, mais il est sur le CD d'installation.

 

Pour l'ordre de tracé, c'est géré dans un dictionnaire (ACAD_SORTENTS).

Un exemple extrait de Cadre&Masque (sur cette page)

 

(setq	space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
(if (vl-catch-all-error-p
(setq sort (vl-catch-all-apply
	     'vla-item
	     (list (vla-getExtensionDictionary
		     space
		   )
		   "ACAD_SORTENTS"
	     )
	   )
)
     )
   (setq sort (vla-addObject
	 (vla-getExtensionDictionary
	   space
	 )
	 "ACAD_SORTENTS"
	 "AcDbSortentsTable"
       )
   )
 )
 (vlax-invoke sort 'MoveToTop olst)

 

*acdoc* = (vla-get-ActiveDocument (vlax-get-acad-object))

olist = liste de vla-object

[draven]

Ok, je vais étudier tout ça.

Merci

 

[draven]

Hello !

Ben je n'ai pas réussi car les notions de RVB et devant / derrière en Visual Lisp sont bien au dela de mes connaissances.

Mais j'ai quand même réussi à faire ça:

 

;;;======  Hach 230 dans Bloc  ==========;;;
(Defun c:H230B (/)
 (command "_.undo" "_be")
 (H2B)
 (hb230)
 (command "_.undo" "_e")
 (princ)
)
(defun hb230 (/)
 (setq blo (tblnext "block" T))
 (while blo
   (setq ent (cdr (assoc -2 blo)))
   (while ent
     (setq lis (entget ent))
     (if (= (cdr (assoc 0 lis)) "HATCH")
(progn
  (setq lis (append lis '((420 . 15132390))))
  (entmod lis)
)
;;fin de progn
     )
     ;; fin de if hatch
     (setq ent (entnext ent))
   )
   ;;fin de while ent
   (princ (strcat "\nTraitement du bloc : "
	   (cdr (assoc 2 blo))
	   " -> OK"
   )
   )
   (setq blo (tblnext "block"))
 )
 ;; fin de while blo  
 (command "regen")
 (princ)
)

(defun H2B (/ doc blocks copylst)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (setq blocks (vla-get-blocks doc))
 (vlax-for x blocks
   (if
     (and
(= :vlax-false (vla-get-isXref x))
;;(zerop (vlax-get x 'IsXref))
(not (eq "*MODEL_SPACE" (strcase (vlax-get x 'Name))))
(not (eq "*PAPER_SPACE" (strcase (vlax-get x 'Name))))
     )
      (vlax-for i x
 (if (not (eq "AcDbHatch" (vlax-get i 'ObjectName)))
   (setq copylst (cons i copylst))
 )
      )
   )
   (if	copylst
     (progn
(vlax-invoke doc 'CopyObjects (reverse copylst) x)
(mapcar 'vla-delete copylst)
     )
   )
   (setq copylst nil)
 )
 (vla-regen doc acActiveViewport)
 (princ)
)

 

Maintenant j'ai un autre petit problème, je fais ça :

(defun c:H0 (/)
 ;;st nom_st nom_st)
;;;  (command "-XREF" "D" "*")
 (setq st (tblnext "style" T))
 (while st
   (setq nst (cdr (assoc 2 st)))
   (subst '(40 . 0.0) (assoc 40 st) st)
   (entmod st)
   (princ (strcat "\nStyle " nst " -> OK"))
   (setq st (tblnext "style"))
 )					;fin de while st
;;;  (command "-XREF" "R" "*")
 (princ)
)

 

mais il ne se passe rien ! est ce quelqu'un pourrait me dire d'où ça vient ?

Cordialement,

DVN