TuttoCAD Forum

TuttoCAD Forum
[ Home | Registrati | Discussioni Attive | Discussioni Recenti | Segnalibro | Msg privati | Sondaggi Attivi | Utenti | Album Fotografico | Download | | Cerca | FAQ ]
Nome Utente:
Password:
Salva Password
Password Dimenticata?

 Tutti i Forum
 1 - TuttoCAD Software
 AutoLISP
 Centreline
 Nuova Discussione  Rispondi
 Versione Stampabile Bookmark this Topic Aggiungi Segnalibro
I seguenti utenti stanno leggendo questo Forum Qui c'è:
Autore Discussione Precedente Discussione Discussione Successiva  

arri
Utente Master


Regione: Lombardia


14951 Messaggi

Inserito il - 01 dicembre 2010 : 11:55:48  Mostra Profilo Invia a arri un Messaggio Privato  Rispondi Quotando
This is quite a simple program to enable a user to quickly add a centreline to an Arc, Circle or Ellipse object.

The centreline length and angle is determined by the user following object selection.


;;--------------------=={ Centreline }==----------------------;;
;;                                                            ;;
;;  Creates a centreline for Arcs, Circles & Ellipses with    ;;
;;  a user-defined length and angle.                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:cl nil (c:Centreline))

(defun c:Centreline ( / e a d p1 p2 ) (vl-load-com)
  ;; Lee Mac 2010

  (if (and
        (setq e
          (LM:Selectif
            (lambda ( e )
              (member (cdr (assoc 0 (entget e))) '("CIRCLE" "ARC" "ELLIPSE"))
            )
            entsel "\nSelect Arc, Circle or Ellipse: "
          )
        )
        (setq p2
          (getpoint (setq p1 (trans (cdr (assoc 10 (entget e))) e 1))
            "\nSpecify Length of Centreline: "
          )
        )
      )
    (progn (setq a (angle p1 p2) d (distance p1 p2))
      (mapcar
        (function
          (lambda ( a d )
            (entmakex
              (list
                (cons 0 "LINE")
                (cons 10 (trans (polar p1 a d) 1 0))
                (cons 11 (trans (polar p1 a (- d)) 1 0))
              )
            )
          )
        )
        (list a (+ a (/ pi 2.))) (list d (- d))
      )
    )
  )
  (princ)
)

;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo fun str / e )
  ;; © Lee Mac 2010
  (while
    (progn (setq e (car (fun str)))      
      (cond
        ( (eq 'ENAME (type e))

          (if (and foo (not (foo e)))
            (princ "\n** Invalid Object Selected **")
          )
        )
      )
    )
  )
  e
)
  Discussione Precedente Discussione Discussione Successiva  
 Nuova Discussione  Rispondi
 Versione Stampabile Bookmark this Topic Aggiungi Segnalibro
Vai a:
TuttoCAD Forum © 2001-2010 CADLandia Torna all'inizio della Pagina
Pagina generata in 0,74 secondi.