You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html
:P ;DYou could use Lee's chain selection: http://www.lee-mac.com/chainsel.html (http://www.lee-mac.com/chainsel.html)
Many thanks Ron - I was just about to suggest that :P
You could use Lee's chain selection: http://www.lee-mac.com/chainsel.html
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
Code: [Select](if (= 1 (getvar 'cvport))
What does this do? In modelspace the cvport is 2. However (cons 410 (getvar 'ctab)) also evaluates to (410 . "Model"), so I'm wondering why this is in there.
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
Consider the case of viewing Modelspace through a Paperspace viewport.
This looked to be an interesting challenge, and so below is my first draft at a possible solution:
(defun c:ssp1p2curveslength ( / len lst pt1 pt2 sel tmp ) (vl-load-com)
(if
(and
(setq sel
(ssget
(list
'(-4 . "<OR")
'(0 . "LINE,ARC")
'(-4 . "<AND")
'(0 . "LWPOLYLINE,SPLINE")
'(-4 . "<NOT")
'(-4 . "&=")
'(70 . 1)
'(-4 . "NOT>")
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "POLYLINE")
'(-4 . "<NOT")
'(-4 . "&")
'(70 . 89)
'(-4 . "NOT>")
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "ELLIPSE")
'(-4 . "<OR")
'(-4 . "<>")
'(41 . 0.0)
'(-4 . "<>")
(cons 42 (+ pi pi))
'(-4 . "OR>")
'(-4 . "AND>")
'(-4 . "OR>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(setq pt1 (getpoint "\n1st point: "))
(setq pt2 (getpoint "\n2nd point: "))
)
(if
(setq tmp
(vl-member-if
(function
(lambda ( itm / tmp )
(cond
( (equal pt1 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt1)) 1e-3)
(setq pt1 tmp)
)
( (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
(mapcar 'set '(pt1 pt2) (list tmp pt1))
)
)
)
)
(LM:sortedchainselection sel)
)
lst
(vl-member-if
(function
(lambda ( itm / tmp )
(if (equal pt2 (setq tmp (vlax-curve-getclosestpointto (cadr itm) pt2)) 1e-3)
(setq pt2 tmp)
)
)
)
(reverse tmp)
)
)
(progn
(if (= (length lst) 1)
(setq len
(abs
(-
(abs
(- (vlax-curve-getdistatpoint (cadar tmp) pt1)
(vlax-curve-getdistatpoint (cadar tmp) (caddar tmp))
)
)
(abs
(- (vlax-curve-getdistatpoint (cadar lst) pt2)
(vlax-curve-getdistatpoint (cadar lst) (caddar lst))
)
)
)
)
)
(setq len
(+
(abs
(- (vlax-curve-getdistatpoint (cadar tmp) pt1)
(vlax-curve-getdistatpoint (cadar tmp) (caddar tmp))
)
)
(abs
(- (vlax-curve-getdistatpoint (cadar lst) pt2)
(vlax-curve-getdistatpoint (cadar lst) (caar lst))
)
)
)
)
)
(foreach itm (cdr (reverse (cdr lst)))
(setq len (+ len (vlax-curve-getdistatparam (cadr itm) (vlax-curve-getendparam (cadr itm)))))
)
(princ (strcat "\nLength: " (rtos len)))
)
(princ "\nThe selected points do not lie on the same chain.")
)
)
(princ)
)
(defun LM:sortedchainselection ( sel / end ent flg idx lst rtn tmp ) (vl-load-com)
(repeat (setq idx (sslength sel))
(setq ent (ssname sel (setq idx (1- idx)))
lst (cons (list (vlax-curve-getstartpoint ent) ent (vlax-curve-getendpoint ent)) lst)
)
)
(setq end (list (caar lst) (caddar lst))
rtn (list (car lst))
lst (cdr lst)
)
(while
(progn
(foreach itm lst
(cond
( (equal (car itm) (car end) 1e-8)
(setq end (cons (caddr itm) (cdr end))
rtn (cons (reverse itm) rtn)
flg t
)
)
( (equal (car itm) (cadr end) 1e-8)
(setq end (list (car end) (caddr itm))
rtn (append rtn (list itm))
flg t
)
)
( (equal (caddr itm) (car end) 1e-8)
(setq end (cons (car itm) (cdr end))
rtn (cons itm rtn)
flg t
)
)
( (equal (caddr itm) (cadr end) 1e-8)
(setq end (list (car end) (car itm))
rtn (append rtn (list (reverse itm)))
flg t
)
)
( (setq tmp (cons itm tmp)))
)
)
flg
)
(setq lst tmp tmp nil flg nil)
)
rtn
)
(defun SELEZIONE_LINEE (/ l0 en0 p0 st sf s1 en0 lfin lnod lpt+ent et)
(setq l0 (entsel "Seleziona Ramo origine")
en0 (car l0)
p0 (cadr l0))
(setq st (getvar 'millisecs)) ;_ inizio controllo primo ciclo
(vl-load-com)
(setq sf (list '(-4 . "<OR")
'(0 . "LINE,ARC")
'(-4 . "<AND")
'(0 . "LWPOLYLINE,SPLINE")
'(-4 . "<NOT")
'(-4 . "&=")
'(70 . 1)
'(-4 . "NOT>")
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "POLYLINE")
'(-4 . "<NOT")
'(-4 . "&")
'(70 . 89)
'(-4 . "NOT>")
'(-4 . "AND>")
'(-4 . "<AND")
'(0 . "ELLIPSE")
'(-4 . "<OR")
'(-4 . "<>")
'(41 . 0.0)
'(-4 . "<>")
(cons 42 (+ pi pi))
'(-4 . "OR>")
'(-4 . "AND>")
'(-4 . "OR>")
(if (= 1 (getvar 'cvport)) ;_limitazione al solo layout corrente
(cons 410 (getvar 'ctab))
'(410 . "Model"))))
(if (setq s1 (ssget "_X" sf)) ;_ tutte le entità che superano il filtro
(setq lfin (ALBERO_GREZZO s1 en0)
lnod (car lfin)
lpt+ent (cdr lfin)))
(setq et (getvar 'millisecs))
(princ (strcat "\nTempo esecuzione programma: " (itoa (- et st)) " ms")))
;#################################################################################################################################################################################################
;;----------------------------------------------------------------------------------------------------------------------------------------------------------------
;|Funzione ricerca rami interconnessi |;
(defun ALBERO_GREZZO (s1 en0 / en fl in l1 ln l2 s2 sf vl ltr ssvl)
(ACET-UI-PROGRESS-INIT
(strcat "Costruzione albero: " (itoa (sslength s1)) " polilinee totali da inserire...")
(sslength s1)) ;_iniz. barra progresso con il totale numero rami
(setq s2 (ssadd en0) ;_creazione gruppo selezione s2 finale, inizialmente con sola entità origine (destinato a contenere anche tutte le entità che formano propaggini)
l1 (list (vlax-curve-getstartpoint en0) (vlax-curve-getendpoint en0)) ;_lista estremi del primo ramo dell'albero (vettore)
ln (list (list (vlax-curve-getstartpoint en0)) (list (vlax-curve-getendpoint en0))) ;_lista nodi (i primi due estremi sono sicuramente dioversi tra loro
ltr (list (append ln (list en0)))) ;_costruzione iniziale lista tratti ltr (vettore e nome ente)
(repeat (setq in (sslength s1)) ;_formazione lista coppie di vertici di tutte le entità ricavate della selezione meno quella origine...
(setq en (ssname s1 (setq in (1- in)))) ;_...estrazione entità
(if (not (eq en en0)) ;_ se l'entità non coincide con quella origine...
(setq vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)))) ;_...di cui si ricavano i vettori (coppia dei vertici) nella lista vl (vector list)
(while (progn (foreach v vl ;_ciascuna coppia di vertici v viene estratta...
(if (vl-some '(lambda (p) (or (equal (car v) p 1e-8) (equal (cadr v) p 1e-8))) l1) ;_alla prima coincidenza di uno dei 2 vertici con un estremo p di l1...
(setq s2 (ssadd (caddr v) s2) ;_...l'ente è aggiunto al gruppo s2
l1 (vl-list* (car v) (cadr v) l1) ;_i punti estremi sono sono aggiunti a l1
ln (LISTA_NODI ln (cdr (reverse v)))
ltr (append (list v) ltr) ;_ così come il corrispondente vettore è aggiunto a ltr
fl t)
(setq l2 (cons v l2)))) ;_...altrimenti v è aggiunto alla lista l2 (rami non accoppiati)
fl)
(setq vl l2 ;_preparazione nuova vl (senza le entità accoppiate) per ripetizione ciclo confronto tra vl e nuova l1 (contenente anche le entità accoppiate)
l2 nil
fl nil)
(ACET-UI-PROGRESS-SAFE (length ltr)) ;_ misura avanzamento barra progresso
)
(if vl
(ERROR_1 vl))
(ACET-UI-PROGRESS-DONE) ;_chiusura barra di processo
(cons ln ltr)) ;_fine defun con passaggio ltr alla funzione chiamante
;| Funzione ricerca nodi; confronta ciascuno dei punti estremi di un vettore con gli elementi della lista nodi.
Se il punto coincide con un nodo già presente viene aggiunto ad esso nella sublista, altrimenti viene aggiunto alla lista nodi come nuova sublista
|;
(defun LISTA_NODI (ln le / sl1 sl2 sl2m lnm) ;(setq lns (mapcar 'car ln));_ lista nodi semplici (lista dei soli punti contenuti in ln)
(setq lnm ln)
(mapcar '(lambda (e / sl2)
(setq sl2 (vl-member-if '(lambda (lp) (equal e (car lp) 1e-8)) lnm)) ;_se estremo è trovato fra i punti di lnm, restituita sl2 (sublista di lnm con estremo al primo posto)
(if sl2 ;_ se esiste sublista sl2...
(setq sl1 (LM:ListDifference lnm sl2) ;... si ricava anche la prima parte come differenza
sl2m (subst (append (car sl2) (list e)) (car sl2) sl2) ;_... si modifica sl2 sostituendone il primo elemento con lo stesso modificato col punto aggiunto
lnm (LM:ListUnion sl1 sl2m)) ;_... quindi si ricostituisce la nuova lnm
(setq lnm (append lnm (list (list e)))))) ;_... altrimenti lnm è modificata con l'aggiunta del punto non coincidente come nuova sublista
le) ;_mapcar applicata al vettore per considerare i due estremi
lnm) ;_fine defun
;; Funzione evidenziazione rami non integrabili nell'albero
(defun ERROR_1 (vl / ssvl)
(setq ssvl (ssadd)) ;_creazione gruppo selezione vuoto
(mapcar '(lambda (en) (ssadd en ssvl)) (mapcar 'caddr vl)) ;_aggiunta a ssvl di tutte le entità non integrate (al terzo posto della lista vl)
(sssetfirst nil ssvl) ;_accensione grip su tutte le entità
(exit)) ;_fine defun
(SELEZIONE_LINEE)