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
 Advanced Polyline Offset
 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 - 16 maggio 2013 : 08:30:00  Mostra Profilo Invia a arri un Messaggio Privato  Rispondi Quotando
fonte

(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
  ;; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
  ;; Alan J. Thompson, 09.29.10
  ;; http://www.cadtutor.net/forum/showthread.php?73308-Multiple-Offsets&p=535978&viewfull=1#post535978
  (vl-load-com)

  (defun foo (e)
    (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
         (not (vlax-curve-isClosed (car e)))
    )
  )

  (defun AT:GetSel (meth msg fnc / ent)
    ;; meth - selection method (entsel, nentsel, nentselp)
    ;; msg - message to display (nil for default)
    ;; fnc - optional function to apply to selected object
    ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
    ;; Alan J. Thompson, 05.25.10
    (while
      (progn (setvar 'ERRNO 0)
             (setq ent (meth (cond (msg)
                                   ("\nSelect object: ")
                             )
                       )
             )
             (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                   ((eq (type (car ent)) 'ENAME)
                    (if (and fnc (not (fnc ent)))
                      (princ "\nInvalid object!")
                    )
                   )
             )
      )
    )
    ent
  )

  (defun _pnts (e / p l)
    (if e
      (cond ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
             (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
            )
            ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
             (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
               (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
             )
            )
      )
    )
  )

  (defun _pline (lst)
    (if (and (> (length lst) 1)
             (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
             (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
        )
      (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
    )
  )

  (defun _lwpline (lst)
    (if (> (length lst) 1)
      (entmakex (append
                  (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        (cons 90 (length lst))
                        (cons 70 (* (getvar 'plinegen) 128))
                  )
                  (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)
                )
      )
    )
  )

  (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

  (if
    (and
      (setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
      (setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
      (not (initget 0 "Lwpolyline Polyline"))
      (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <"
                                               (cond (*LBL:Opt*)
                                                     ((setq *LBL:Opt* "Lwpolyline"))
                                               )
                                               ">: "
                                       )
                             )
                            )
                            (*LBL:Opt*)
                      )
      )
    )
     ((if (eq *LBL:Opt* "Lwpolyline")
        _lwpline
        _pline
      )
       (vl-remove nil
                  (mapcar (function (lambda (a b)
                                      (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
                                        (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b)
                                      )
                                    )
                          )
                          e1
                          (if (< (_dist (car e1) (car e2))
                                 (_dist (car e1) (last e2))
                              )
                            e2
                            (reverse e2)
                          )
                  )
       )
     )
  )
  (princ)
)
  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,44 secondi.