Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Routine Cadre Blanc pluis ombre type POLAROID

Invité ingoenius

Par Invité ingoenius
dans Pour aller plus loin en LISP

 Partager

Messages recommandés

Invité ingoenius

Invité ingoenius

Posté(e)
Posté(e)

Ici une petite routine complète qui dessine un cadre avec bord arrondis Rempli en Blanc imprimable, et avec son ombre porté en gris

 

 

 

 
(defun mid (p1 p2)
 (list
   (/ (+ (car p1) (car p2)) 2.0)
   (/ (+ (cadr p1) (cadr p2)) 2.0)
 )
)


(defun C:QQQ ()			;Crea Quadro + ombra

(setq DTR (/ PI 180))		;fattore di moltiplicazione x gradi verso radianti  pi é Pi greco!
(setq DESTRA (* 0 DTR))		;traduzione del comando polar  
(setq SINISTRA (* 180 DTR))	;traduzione del comando polar 
(setq SU (* 90 DTR))		;traduzione del comando polar 
(setq GIU (* 270 DTR))		;traduzione del comando polar 
(setq DIAG (* 45 DTR))		;traduzione del comando polar

 
(setq HPold(GETVAR "HPNAME" )) 		;parametro hp typo hachura
(setq ACCRold(GETVAR "OSMODE" )) 	;parametri snap
(setq Colorold(GETVAR "CECOLOR" )) 	;parametri color

(SETVAR "OSMODE" 0) 			;toglie gli snap

 
(setq  P1 (getpoint "\nGet Point:"))
(command "_rectang" P1 pause "")
(setq P2(GETVAR "lastpoint" )) ;recupero l'ultimo punto inserito
(setq Rettangolo (entlast));nomino il rettangolo
 
(setq Pmid (mid P1 P2));microprogramma per trovare il punto mediano

 
(setq xP1 (car p1))
(setq xP2 (car P2))
(setq Distx (- xP2 xP1))
(setq yP1 (cadr P1))
(setq yP2 (cadr P2))
(setq Disty (- yP2 yP1))

(setq P3 (list (car P2)(cadr P1)0.0))  
(setq P4 (list (car P1)(cadr P2)0.0))

(SETVAR "CECOLOR" "Blanc") ;Colore linee 

 
(command "_line" P1 P3 "" "")
(setq L1 (entlast))
 
(command "_line" P3 P2 "" "")  
(setq L2 (entlast))
 
(command "_line" P2 P4 "" "")
(setq L3 (entlast))  
(command "_line" P4 P1 "" "")
(setq L4 (entlast))

;-------CREAZIONE DEI FILLET-------------------------------------------
(setq Raggio (/ Distx 20.0))

;(SETVAR "OSMODE" 513) ;snap vicino  

;(setq Raggio (getdist "\nRaggio curvatura "))
(setvar "FILLETRAD" Raggio);variabile raggio di fillet

(command "_fillet" L1 L2)
(setq R1 (entlast))

(command "_fillet" L2 L3)
(setq R2 (entlast))

(command "_fillet" L3 L4)
(setq R3 (entlast))

(command "_fillet" L4 L1)
(setq R4 (entlast))

(SETVAR "OSMODE" 0) ;toglie gli snap
 
(setq mySet(ssadd))
;(setq mySet(ssadd L1 mySet))
(setq mySet(ssadd L2 mySet))
(setq mySet(ssadd L3 mySet))
(setq mySet(ssadd L4 mySet))
(setq mySet(ssadd R1 mySet))
(setq mySet(ssadd R2 mySet))
(setq mySet(ssadd R3 mySet))
(setq mySet(ssadd R4 mySet))

;-------CREAZIONE OFFSET -------------------------------------------
 
(setq OffDist (getdist "\nGet Offset Dist "))
(setvar "OFFSETDIST" OffDist)

;(setvar "OFFSETDIST" (* 1.5 Raggio))
;(setq DistOFF (/ Raggio 3.0))  
;(setvar "OFFSETDIST" DistOFF)

(setq DistCadre ( / OffDist 3.0))  

(command "_pedit" L1 "" "j" mySet "" "")
(setq CarAr (entlast))  
(command "_offset" "" CarAr Pmid "" "")
(setq CarAr_Int (entlast))   

(command "_region" CarAr "")  
(setq CarAr (entlast))

(command "_region" CarAr_Int "")  
(setq CarAr_Int (entlast))
 
(command "_subtract" Carar "" CarAr_Int "" )
(setq Cornice(entlast))

(SETVAR "HPNAME" "solid") 	 ;Setto il tipo di hachure
(SETVAR "CECOLOR" "255,255,254") ;Setto il colore Falso bianco par l'hachure
(command "-hachures" "S" Cornice "" "" "" )
(setq Campitura(entlast))


(setq P4B (polar P4 SINISTRA DistCadre))  
(setq P4B (polar P4B GIU DistCadre))

(command "_copy" Campitura "" P4 P4B "")
(setq Campitura2(entlast))
(command "_Draworder" Campitura2 "" "AR" "")  

(setq colore 9);GRIS  
(command "_change" Campitura2 "" "pr"  "_co" colore "" )
(command "_erase" Rettangolo "" "")  
 
;-------RESET DELLE VARIABILI INIZIALI -------------------------------------------

(SETVAR "CECOLOR" Colorold) ;rimette il colore
(SETVAR "OSMODE" ACCRold) ;rimette lo snap
(SETVAR "HPNAME" HPoldd) ;rimette il tipo achura
 
)

RhymOne Newbie

RhymOne

Posté(e)
Posté(e)

Bonjour,

Vraiment intéressant comme lisp....

Dommage que l'espagnol n'est pas mon fort

DAO: AutoCAD(2D & 3D), Covadis

CAO: 3D's MAX, Rhinoceros 3D, REVIT

GeoModeliSation: AutoCAD MEP, RhinoTerrain

Rendu: Vray for Rhino, Keyshot, Lumion

Programmation: Grasshopper, Dynamo, VisualStudio

 

C.V.

Profil LinkedIn

Book

Site web

 

http://nsa37.casimages.com/img/2016/09/26/160926023334168603.jpg

RhymOne Newbie

RhymOne

Posté(e)
Posté(e)

(Re)

Oui c'est de l'italien je confirme après essai d'une traduction.

Pour ma part le lisp fonctionne nickel...

DAO: AutoCAD(2D & 3D), Covadis

CAO: 3D's MAX, Rhinoceros 3D, REVIT

GeoModeliSation: AutoCAD MEP, RhinoTerrain

Rendu: Vray for Rhino, Keyshot, Lumion

Programmation: Grasshopper, Dynamo, VisualStudio

 

C.V.

Profil LinkedIn

Book

Site web

 

http://nsa37.casimages.com/img/2016/09/26/160926023334168603.jpg

Invité ingoenius

Invité ingoenius

Posté(e)
Posté(e)

Bah oui c'est de l'italine desolé (car en francais je fais trop de fautes)

pour les commentaires, ici une variante pour faite la même chose a partir d'un objet cercle ellipse poli ligne fermé ou spline fermée si peut vous intéresser

 

 
(defun C:QQP ()			;Crea Quadro + ombra

(setq DTR (/ PI 180))		;fattore di moltiplicazione x gradi verso radianti  pi é Pi greco!
(setq DESTRA (* 0 DTR))		;traduzione del comando polar  
(setq SINISTRA (* 180 DTR))	;traduzione del comando polar 
(setq SU (* 90 DTR))		;traduzione del comando polar 
(setq GIU (* 270 DTR))		;traduzione del comando polar 
(setq DIAG (* 45 DTR))		;traduzione del comando polar

 
(setq HPold(GETVAR "HPNAME" )) 		;parametro hp typo hachura
(setq ACCRold(GETVAR "OSMODE" )) 	;parametri snap
(setq Colorold(GETVAR "CECOLOR" )) 	;parametri color

(SETVAR "OSMODE" 0) 			;toglie gli snap

 
 
;(setq Pmid (mid P1 P2));microprogramma per trovare il punto mediano

(SETVAR "CECOLOR" "Blanc") ;Colore linee 

;-------CREAZIONE OFFSET -------------------------------------------
 

;(command "_pedit" L1 "" "j" pause "" "")


 
;(setq CarAr (entlast))

;(SETVAR "OSMODE" 512)   
;(setq P4 (getpoint))  
(setq CarAr (car (entsel )))

(setq DatiCarar (entget CarAr))  
(setq Tipo (cdr (assoc 0 DatiCarar)));determino se é una spline
 

;se é una spline trasformo in polilinea    
 
(if
 (= Tipo "SPLINE");se  é una spline
(progn
 	(command "_pedit"  CarAr "" ""  "" "");solo se é una spline 
(setq CarAr (entlast))
)
	(setq CarAr CarAr)
 )
 

 

(SETVAR "OSMODE" 512)   
(setq P4 (getpoint "\nGet Point1:"))
(SETVAR "OSMODE" 0)
(setq P5 (getpoint "\nGet Point2:"))

(setq OffDist (distance P4 P5))

(setvar "OFFSETDIST" OffDist)
(setq DistCadre ( / OffDist 3.0))  


(command "_offset" "" CarAr P5 "" "")
(setq CarAr_Int (entlast))   

(command "_region" CarAr "")  
(setq CarAr (entlast))

(command "_region" CarAr_Int "")  
(setq CarAr_Int (entlast))
 
(command "_subtract" Carar "" CarAr_Int "" )
(setq Cornice(entlast))

 
(SETVAR "HPNAME" "solid") 	 ;Setto il tipo di hachure
(SETVAR "CECOLOR" "255,255,254") ;Setto il colore Falso bianco par l'hachure
(command "-hachures" "S" Cornice "" "" "" )
(setq Campitura(entlast))


(setq P4B (polar P4 SINISTRA DistCadre))  
(setq P4B (polar P4B GIU DistCadre))

(command "_copy" Campitura "" P4 P4B "")
(setq Campitura2(entlast))
(command "_Draworder" Campitura2 "" "AR" "")  

(setq colore 9);GRIS  
(command "_change" Campitura2 "" "pr"  "_co" colore "" )
(command "_erase" Rettangolo "" "")  
 
;-------RESET DELLE VARIABILI INIZIALI -------------------------------------------

(SETVAR "CECOLOR" Colorold) ;rimette il colore
(SETVAR "OSMODE" ACCRold) ;rimette lo snap
(SETVAR "HPNAME" HPoldd) ;rimette il tipo achura
 
)

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité