mligne multicalque

PHILPHIL · le 13 septembre 2008

hello

petite contribution aux routines LISp

doit falloir effacer l'espace apres les deux petits points (:)

lancer "PARAPOLI" en premier

rentrer les parametres de décalage et de calques

puis "PPOLI" ensuite creer une premiere polyligne de réference normalement

le reste suivra

ameliorations en vue ???

( demande de conseils aux pros du LISP et VLisp ici present )

integrer directement "parapoli" sur la ligne de commande de ppoli

integrer le choix des calques avec le LISP de GILE (GETLAYER ) la je bloque ....

décomposer les polylignes a la fin ????? ( nécéssaire ??? )

créer a partir de l'axe ?? plus difficile la

si d'autre sugestions vous viennent ??

phil

 (DEFUN C: PARAPOLI ()
 (SETQ OSM (GETVAR "osmode"))
 (SETQ DECAPOLI1 (ATOF (GETCFG "APPDATA/DECAPOLI1")))
 (SETQ DECAPOLI2 (ATOF (GETCFG "APPDATA/DECAPOLI2")))
 (SETQ DECAPOLI3 (ATOF (GETCFG "APPDATA/DECAPOLI3")))
 (SETQ DECAPOLI4 (ATOF (GETCFG "APPDATA/DECAPOLI4")))
 (SETQ TCALQPOLI0 (GETCFG "APPDATA/tcalqPOLI0"))
 (SETQ TCALQPOLI1 (GETCFG "APPDATA/tcalqPOLI1"))
 (SETQ TCALQPOLI2 (GETCFG "APPDATA/tcalqPOLI2"))
 (SETQ TCALQPOLI3 (GETCFG "APPDATA/tcalqPOLI3"))
 (SETQ TCALQPOLI4 (GETCFG "APPDATA/tcalqPOLI4"))

  (SETQ	OBJET (ENTSEL
	(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 0 : " TCALQPOLI0 " ")
      )
 )
 (IF OBJET
   (SETQ TCALQPOLI0 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
 )

 (SETQ TMP (GETDIST (STRCAT "\nENTRER LA VALEUR DE DECALAGE N° 1 <" (RTOS DECAPOLI1 2 8) ">: ")))
 (IF TMP
   (SETQ DECAPOLI1 TMP)
 )
 (SETQ	OBJET (ENTSEL
	(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 1 : " TCALQPOLI1 " ")
      )
 )
 (IF OBJET
   (SETQ TCALQPOLI1 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
 )
 (SETQ TMP (GETDIST (STRCAT "\nENTRER LA VALEUR DE DECALAGE N° 2 <" (RTOS DECAPOLI2 2 8) ">: ")))
 (IF TMP
   (SETQ DECAPOLI2 TMP)
 )
 (SETQ	OBJET (ENTSEL
	(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 2 : " TCALQPOLI2 " ")
      )
 )
 (IF OBJET
   (SETQ TCALQPOLI2 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
 )
 (SETQ TMP (GETDIST (STRCAT "\nENTRER LA VALEUR DE DECALAGE N° 3 <" (RTOS DECAPOLI3 2 8) ">: ")))
 (IF TMP
   (SETQ DECAPOLI3 TMP)
 )
 (SETQ	OBJET (ENTSEL
	(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 3 : " TCALQPOLI3 " ")
      )
 )
 (IF OBJET
   (SETQ TCALQPOLI3 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
 )
 (SETQ TMP (GETDIST (STRCAT "\nENTRER LA VALEUR DE DECALAGE N° 4 <" (RTOS DECAPOLI4 2 8) ">: ")))
 (IF TMP
   (SETQ DECAPOLI4 TMP)
 )
 (SETQ	OBJET (ENTSEL
	(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 4 : " TCALQPOLI4 " ")
      )
 )
 (IF OBJET
   (SETQ TCALQPOLI4 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
 )
 (SETCFG "APPDATA/DECAPOLI1" (RTOS DECAPOLI1 2 8))
 (SETCFG "APPDATA/DECAPOLI2" (RTOS DECAPOLI2 2 8))
 (SETCFG "APPDATA/DECAPOLI3" (RTOS DECAPOLI3 2 8))
 (SETCFG "APPDATA/DECAPOLI4" (RTOS DECAPOLI4 2 8))
 (SETCFG "APPDATA/TCALQPOLI0" TCALQPOLI0)
 (SETCFG "APPDATA/TCALQPOLI1" TCALQPOLI1)
 (SETCFG "APPDATA/TCALQPOLI2" TCALQPOLI2)
 (SETCFG "APPDATA/TCALQPOLI3" TCALQPOLI3)
 (SETCFG "APPDATA/TCALQPOLI4" TCALQPOLI4)
 (SETVAR "osmode" OSM)
 (PRINC)
)

 (defun C: PPOLI (/  )
 (setvar "cmdecho" 0)
 (setq CAV (getvar "clayer"))
 (SETQ DECAPOLI1 (ATOF (GETCFG "APPDATA/DECAPOLI1")))
 (SETQ DECAPOLI2 (ATOF (GETCFG "APPDATA/DECAPOLI2")))
 (SETQ DECAPOLI3 (ATOF (GETCFG "APPDATA/DECAPOLI3")))
 (SETQ DECAPOLI4 (ATOF (GETCFG "APPDATA/DECAPOLI4")))
(SETQ TCALQPOLI0 (GETCFG "APPDATA/tcalqPOLI0"))
 (SETQ TCALQPOLI1 (GETCFG "APPDATA/tcalqPOLI1"))
 (SETQ TCALQPOLI2 (GETCFG "APPDATA/tcalqPOLI2"))
 (SETQ TCALQPOLI3 (GETCFG "APPDATA/tcalqPOLI3"))
 (SETQ TCALQPOLI4 (GETCFG "APPDATA/tcalqPOLI4"))

(SETQ NBPOLI (ATOI (GETCFG "APPDATA/NBPOLI")))
 
(initget "2 3 4 5")
(SETQ TMP (GETINT (STRCAT "\nENTRER LE LE NB DE POLYLIGNE EN TOUT UNE FOIS LES DECALAGES EFFECTUES <" (RTOS NBPOLI 2 0) ">: ")))
 (IF TMP
   (SETQ NBPOLI TMP)
 )
(command "-calque" "ac" TCALQPOLI0 "")
  (command "-calque" "ch" TCALQPOLI0 "")


 
 (command "polylign" (while (> (getvar "cmdactive") 0) (command PAUSE)))
 (setq OSM (getvar "osmode"))
 (setvar "osmode" 0)
 (command "scu" "")
 (setq POREF1 (entlast))

  (setq ENTITEPOINTS (mapcar 'cdr (vl-remove-if-not '(lambda (X) (= (car X) 10)) (entget POREF1)))
 PT1	      (car ENTITEPOINTS)
 PT2	      (cadr ENTITEPOINTS)
  )
  (setq ANGLEPL (angle PT1 PT2))
  (setq PTGAUCHE (polar PT1 (+ ANGLEPL (/ pi 2)) 10))
  (setq PTDROITE (polar PT1 (- ANGLEPL (/ pi 2)) 10))






(IF (= NBPOLI 2)
  (PROGN
    (COMMAND "DECALER" DECAPOLI1 POREF1 PTGAUCHE "")
 (SETQ PONOU1 (ENTLAST))
 (SETQ PONOU1A (ENTGET (ENTLAST)))
 (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
 (ENTMOD PONOU1A)
 (INITGET "O N")
 (SETQ ANS (GETKWORD "\nEST CE LE BON COTE ? (O/N):"))

 (IF (= ANS "N")
   (PROGN (COMMAND "EFFACER" PONOU1 "")
   (COMMAND "DECALER" DECAPOLI1 POREF1 PTDROITE "")
   (SETQ PONOU1A (ENTGET (ENTLAST)))
   (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
   (ENTMOD PONOU1A)
   )
 )
 )
)

(IF (= NBPOLI 3)
 (PROGN (COMMAND "DECALER" DECAPOLI1 POREF1 PTGAUCHE "")
 (SETQ PONOU1 (ENTLAST))
 (SETQ PONOU1A (ENTGET (ENTLAST)))
 (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
 (ENTMOD PONOU1A)
 (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTGAUCHE "")
 (SETQ PONOU2 (ENTLAST))
 (SETQ PONOU2A (ENTGET (ENTLAST)))
 (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
 (ENTMOD PONOU2A)
 (INITGET "O N")
 (SETQ ANS (GETKWORD "\nEST CE LE BON COTE ? (O/N):"))
 (IF (= ANS "N")
   (PROGN (COMMAND "EFFACER" PONOU1 PONOU2 "")
	  (COMMAND "DECALER" DECAPOLI1 POREF1 PTDROITE "")
	  (SETQ PONOU1A (ENTGET (ENTLAST)))
	  (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
	  (ENTMOD PONOU1A)
	  (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTDROITE "")
	  (SETQ PONOU2A (ENTGET (ENTLAST)))
	  (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
	  (ENTMOD PONOU2A)
   )
 )
 )
)

(IF (= NBPOLI 4)
 (PROGN (COMMAND "DECALER" DECAPOLI1 POREF1 PTGAUCHE "")
 (SETQ PONOU1 (ENTLAST))
 (SETQ PONOU1A (ENTGET (ENTLAST)))
 (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
 (ENTMOD PONOU1A)
 (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTGAUCHE "")
 (SETQ PONOU2 (ENTLAST))
 (SETQ PONOU2A (ENTGET (ENTLAST)))
 (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
 (ENTMOD PONOU2A)
 (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3) POREF1 PTGAUCHE "")
 (SETQ PONOU3 (ENTLAST))
 (SETQ PONOU3A (ENTGET (ENTLAST)))
 (SETQ PONOU3A (SUBST (CONS 8 TCALQPOLI3) (ASSOC 8 PONOU3A) PONOU3A))
 (ENTMOD PONOU3A)
   
 (INITGET "O N")
 (SETQ ANS (GETKWORD "\nEST CE LE BON COTE ? (O/N):"))
 (IF (= ANS "N")
   (PROGN (COMMAND "EFFACER" PONOU1 PONOU2 PONOU3 "")
	  (COMMAND "DECALER" DECAPOLI1 POREF1 PTDROITE "")
	  (SETQ PONOU1A (ENTGET (ENTLAST)))
	  (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
	  (ENTMOD PONOU1A)
	  (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTDROITE "")
	  (SETQ PONOU2A (ENTGET (ENTLAST)))
	  (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
	  (ENTMOD PONOU2A)
    		  (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3) POREF1 PTDROITE "")
	  (SETQ PONOU3A (ENTGET (ENTLAST)))
	  (SETQ PONOU3A (SUBST (CONS 8 TCALQPOLI3) (ASSOC 8 PONOU3A) PONOU3A))
	  (ENTMOD PONOU3A)

   )
 )
 )
)

(IF (= NBPOLI 5)
 (PROGN (COMMAND "DECALER" DECAPOLI1 POREF1 PTGAUCHE "")
 (SETQ PONOU1 (ENTLAST))
 (SETQ PONOU1A (ENTGET (ENTLAST)))
 (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
 (ENTMOD PONOU1A)
 (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTGAUCHE "")
 (SETQ PONOU2 (ENTLAST))
 (SETQ PONOU2A (ENTGET (ENTLAST)))
 (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
 (ENTMOD PONOU2A)
 (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3) POREF1 PTGAUCHE "")
 (SETQ PONOU3 (ENTLAST))
 (SETQ PONOU3A (ENTGET (ENTLAST)))
 (SETQ PONOU3A (SUBST (CONS 8 TCALQPOLI3) (ASSOC 8 PONOU3A) PONOU3A))
 (ENTMOD PONOU3A)
   (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3 DECAPOLI4) POREF1 PTGAUCHE "")
 (SETQ PONOU4 (ENTLAST))
 (SETQ PONOU4A (ENTGET (ENTLAST)))
 (SETQ PONOU4A (SUBST (CONS 8 TCALQPOLI4) (ASSOC 8 PONOU4A) PONOU4A))
 (ENTMOD PONOU4A)
   
 (INITGET "O N")
 (SETQ ANS (GETKWORD "\nEST CE LE BON COTE ? (O/N):"))
 (IF (= ANS "N")
   (PROGN (COMMAND "EFFACER" PONOU1 PONOU2 PONOU3 PONOU4 "")
	  (COMMAND "DECALER" DECAPOLI1 POREF1 PTDROITE "")
	  (SETQ PONOU1A (ENTGET (ENTLAST)))
	  (SETQ PONOU1A (SUBST (CONS 8 TCALQPOLI1) (ASSOC 8 PONOU1A) PONOU1A))
	  (ENTMOD PONOU1A)
	  (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2) POREF1 PTDROITE "")
	  (SETQ PONOU2A (ENTGET (ENTLAST)))
	  (SETQ PONOU2A (SUBST (CONS 8 TCALQPOLI2) (ASSOC 8 PONOU2A) PONOU2A))
	  (ENTMOD PONOU2A)
    		  (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3) POREF1 PTDROITE "")
	  (SETQ PONOU3A (ENTGET (ENTLAST)))
	  (SETQ PONOU3A (SUBST (CONS 8 TCALQPOLI3) (ASSOC 8 PONOU3A) PONOU3A))
	  (ENTMOD PONOU3A)
     (COMMAND "DECALER" (+ DECAPOLI1 DECAPOLI2 DECAPOLI3 DECAPOLI4) POREF1 PTDROITE "")
	  (SETQ PONOU4A (ENTGET (ENTLAST)))
	  (SETQ PONOU4A (SUBST (CONS 8 TCALQPOLI4) (ASSOC 8 PONOU4A) PONOU4A))
	  (ENTMOD PONOU4A)

   )
 )
 )
)
 


 
 (SETCFG "APPDATA/NBPOLI" (RTOS NBPOLI 2 0))
 (setvar "clayer" CAV)
 (command "scu" "P")
  (setvar "osmode" OSM)
  (princ)
)

[Edité le 13/9/2008 par PHILPHIL]

(gile) · le 13 septembre 2008

Salut,

integrer le choix des calques avec le LISP de GILE (GETLAYER ) la je bloque ....

Pourtant ça n'est pas difficile.

Il suffit que la routine soit chargée, et de remplacer dans ta routine :

(SETQ OBJET (ENTSEL
(STRCAT "\nVEUILLEZ SELECTIONNER UN OBJET POUR LE CALQUE DE REFERENCE N° 0 : " TCALQPOLI0 " ")
)
)
(IF OBJET
(SETQ TCALQPOLI0 (CDR (ASSOC 8 (ENTGET (CAR OBJET)))))
)

par :

(setq tcalqpoli0 (getlayer "Calque de référence 0"))

Lis les commentaires au début de la routine, ils expliquent comment l'utiliser.

PS : Pourquoi écris-tu tout en majuscule ? Je trouve ça pénible à lire.

Connexion

mligne multicalque

Messages recommandés

PHILPHIL

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante