Créer des commandes existantes

[Matt666]

Salut !

 

Quand j'ai commencé le Lisp, je m'arrachais les cheveux à essayer de comprendre comment fonctionnent les commandes existantes AutoCAD. Mon premier souhait aurait été de pouvoir voir le code d'une de ces commandes.

 

Alors voilà si ça sert à mieux comprendre le fonctionnement du lisp, voici quelques exemples simples (enfin dans son utilisation !!!) de la commande LIGNE...

 

Bon comme d'hab le code est loin d'être concis, désolé..

 

Bon je commence. On va voir quatre méthodes pour créer une ou plusieurs lignes.

 

La première est la plus simple : Créer une ligne à partir de deux points. Ici on utilise la commende existante par le biais de la fonction "command".

;;; Créé une ligne simple avec la fonction command
(defun c:lign_sim_cmd ()
    (command "_line")
    (princ "\nSpécifiez Premier point : ")
    (command pause)
    (princ "\nSpécifiez le point suivant :")
    (command pause "")
    (princ)
)

 

La deuxième permet de créer une ligne simple sans utiliser la commande existante. Donc au moyen d'un "entmake".

;;; Créé une ligne simple avec la fonction entmake
(defun c:Lign_sim_ent (/ pt1)
    (entmake (list
              (cons 0 "LINE")
              (cons 10 (setq pt1 (getpoint "\nSpécifiez Premier point : ")))
              (cons 11 (getpoint pt1 "\nSpécifiez le point suivant :"))
    ))
    (princ)
)

 

La troisième méthode permet de dessiner plusieurs lignes avec la commande existante.

Pour cela il faut utiliser une boucle (while) qui vérifie l' état de la ligne de commande (avec la variable "CMDACTIVE".

;;; Créé une ou plusieurs lignes avec la fonction command
(defun c:lign_mul_cmd ()
    (command "_line")
    (princ "\nSpécifiez Premier point : ")
    (command pause)
    (while (not (zerop (getvar "cmdactive")))
         (princ "\nSpécifiez le point suivant ou [annUler] : ")
         (command pause)
    )
    (princ)
)

 

Enfin la quatrième méthode, et de (très) loin la plus compliquée, consiste à créer une ou plusieurs lignes sans la commande existante. On va utiliser des fonctions personnelles...

Voici la fonction principale :

;;; Créé une ou plusieurs lignes avec la fonction entmake
(defun c:lign_mul_ent (/ LASTENT LST PT1 PT2 PTST)
    (setq lst nil)
    (princ "\nSpécifiez le premier point : ")
    (setq pt1 (getpoint "\nSpécifiez le premier point : "))
    (if (not pt1) 
         (if (or   (not (entlast))
                   (not (member (cdr (assoc 0 (entget (entlast)))) '("LINE" "ARC")))
              )
              (progn
                   (setq pt1 nil)
                   (while (not (setq pt1 (getpoint "\nAucune ligne ou arc à continuer.\nSpécifiez le premier point : "))))
              )
              (if  
                   (and (setq lastent (entget (entlast)))
                        (eq (cdr (assoc 0 lastent)) "LINE")
                   )
                   (setq pt1 (cdr (assoc 11 lastent)))
                   (if (and 
                             lastent
                             (eq (cdr (assoc 0 lastent)) "ARC")
                        )
                        (setq pt1 (polar 
                                  (cdr (assoc 10 lastent))
                                  (cdr (assoc 51 lastent))
                                  (cdr (assoc 40 lastent))
                        ))
                   )
              )
         )
    )
    (if pt1 (progn
              (setq ptst pt1)
              (initget 128)
              (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : "))
              (while pt2
                   (cond 
                        ((eq (type pt2) 'LIST)
                             (entmake (list
                                       (cons 0 "LINE")
                                       (cons 10 pt1)
                                       (cons 11 pt2)
                             ))
                             (setq lst (cons (entlast) lst))
                             (initget 128)
                             (if (> (length lst) 1)
                                  (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : "))
                                  (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : "))
                             )
                        )
                        ((eq (strcase pt2) "U")
                             (if (> (length lst) 1)
                                  (progn
                                       (entdel (car lst))
                                       (setq lst (vl-remove (car lst) lst))
                                       (setq pt1 (cdr (assoc 11 (entget (car lst)))))
                                  )
                                  (if (eq (length lst) 1)
                                       (progn
                                            (entdel (car lst))
                                            (setq lst nil pt1 ptst)
                                       )
                                  )
                             )
                             (initget 128)
                             (if (> (length lst) 1)
                                  (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : "))
                                  (setq pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : "))
                             )
                        )
                        ((eq (strcase pt2) "C")
                             (entmake (list
                                       (cons 0 "LINE")
                                       (cons 10 (cdr (assoc 11 (entget (car lst)))))
                                       (cons 11 (cdr (assoc 10 (entget (last lst)))))
                             ))
                             (setq pt2 nil)
                        )
                        ((eq (type pt2) 'STR)
                             (if (not (member (strcase pt2) '("U" "C")))
                                  (progn
                                       (entmake (list
                                                 (cons 0 "LINE")
                                                 (cons 10 pt1)
                                                 (cons 11 (setq pt2 (getcrd pt2 pt1)))
                                       ))
                                       (setq lst (cons (entlast) lst))
                                       (initget 128)
                                       (if (> (length lst) 1)
                                            (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler/Clore] : "))
                                            (setq pt1 pt2 pt2 (getpoint pt1 "\nSpécifiez le point suivant ou [annUler] : "))
                                       )
                             ))
                        )
                   )
              )
    ))
    (princ)
)

 

Et les fonctions associées :

;;; Retourne les coordonnées en fonction de la casse de la chaîne de caractères
(defun getcrd (str first / )
    (cond 
         ((eq (substr str 1 1) "@")
              (+ (str2lst (substr str 2 (strlen str)) ",") first)
         )
         ((vl-string-position (ascii ",") str nil nil)
              (str2lst (substr str 1 (strlen str)) ",")
         )
         ((vl-string-position (ascii "<") str nil nil)
              (polar 
                   '(0 0 0) 
                   (atof (cadr (str2lst str "<")))
                   (str2lst str "<")
                   (car (str2lst str "<"))
              )
         )
         ((and 
                   (vl-string-position (ascii "<") str nil nil)
                   (eq (substr str 1 1) "@")
              )
              (polar 
                   first 
                   (atof (substr 
                             (str2lst str "<") 
                             2
                             (strlen (car (str2lst str "<")))
                   ))
                   (str2lst str "<")
                   (car (str2lst str "<"))
              )
         )
         ((not (vl-string-position (ascii ",") str nil nil))
              (polar 
                   first
                   (angtof (itoa 
                             (proch 
                                  (atoi (angtos (angle pt1 (cadr (grread 3))))) 
                                  '(0 45 90 135 180 225 270 315 360)
                             )
                   ))
                   (chtype str)
              )
         )
    )
)

;;;****************************************************************
;;; CHTYPE
;;; Retourne la vraie forme de la chaîne de caractère.
(defun chtype (CRT / )
    (if (eq CRT "0")
         (atoi CRT)
         (if (and 
                   (/= (atoi CRT) 0)
                   (not (vl-string-search "." crt nil))
              )
              (atoi CRT)
              (if (/= (atof CRT) 0.00)
                   (atof CRT)
                   CRT
              )
         )
    )
)

;;;****************************************************************
;;; Retourne l'élément de la liste le plus proche du nombre demandé.

(defun proch (nb lst / )
    (setq lst (cons 
              (nth 
                   (1- (vl-position nb (vl-sort (cons nb lst) '<)))
                   lst
              )
              (list (nth 
                        (vl-position nb (vl-sort (cons nb lst) '<))
                        lst
              ))
         )
    )
    (if (<= (- nb (car lst)) (- (last lst) nb))
         (car lst)
         (last lst)
    )
)

;;;****************************************************************
;;; STR2LST
;;; Retourne une liste à partir d'une chaîne de caractères concaténée avec un caratère de séparation
;;; str = Chaîne de caractères
;;; sep = caractère de séparation
;;; 
;;; (str2lst "0,1,,,,2,3,4,5,6,7,8,9" ",") -> (0 1 "" "" "" 2 3 4 5 6 7 8 9)
;;; (str2lst "0,1,2,3,4,5,6,7,8,9" "" ) -> ("0" "," "1" "," "2" "," "3" "," "4" "," "5" "," "6" "," "7" "," "8" "," "9")

(defun str2lst (str sep / pos lst )
    (if (/= sep "")
         (progn (while (setq pos (vl-string-search sep str nil))
                   (setq 
                        lst (cons (chtype (substr str 1 pos)) lst)
                        str (substr str (+ (strlen sep) pos 1)
                        )
                   )
              )
              (setq lst (cons (chtype str) lst))
         )
         (progn 
              (while (/= str "")
                   (setq 
                        lst (cons (chtype (substr str 1 1)) lst)
                        str (substr str 2)
                   )
              )
         )
    )
    (if lst (reverse lst))
)

 

Ces commandes fonctionnent sur AutoCAD2000. Pour qu'elles fonctionnent sur un moteur IntelliCAD, il faut supprimer tous les vl- (ex vl-position = position) et choper toutes les fonctions créées par Gile pour palier l'absence de vl dans ces moteurs.

 

Voilà ! Si d'autres sont motivés à créer des fonctions existantes pour comprendre un peu mieux le lisp, qu'ils n'hésitent surtout pas !! Perso je vais m'essayer au rectangle...

 

A bientot.

Matt.

[Patrick_35]

Bien, matt666 :)

 

Et de cette manière ;)

 

(command "_.line")
(while (not (zerop (getvar "cmdactive")))(command pause))

 

@+

[Matt666]

Ah bah oui, encore plus simple !!!

 

Je l'avais fait comme ça, aussi, mais ma variable "cmdecho" était à zéro, donc aucun message visible !!

C'est pour ça que j'ai du insérer des messages...

 

Petite erreur de derrière les fagots !!

 

Merci Patrick_35 !

A bientôt.

Matt.