| V I S U A L I Z Z A D I S C U S S I O N E |
| arri |
Inserito il - 12 novembre 2012 : 12:55:54
fonte
(defun C:BKG (/ *ERROR* ar OS OL LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1
PBT2)
(SETVAR "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(setq ar (getreal "\nDistance of gap: ")); <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(setq OL (getvar "clayer"))
(while (not
(setq ENT1 (car (entsel "\nSelect crossing line to break: ")))
)
(princ "\nNull Selection please try again: ")
)
(setq LINE1 (entget ENT1))
(setq LN (cdr (assoc 8 LINE1)))
(setq P1 (trans (cdr (assoc 10 LINE1)) 0 1))
(setq P2 (trans (cdr (assoc 11 LINE1)) 0 1))
(setq AN (angle P1 P2))
(while (not
(setq ENT2 (car (entsel "\nSelect line to cross over: ")))
)
(princ "\nNull Selection please try again: ")
)
(setq LINE2 (entget ENT2))
(setq P3 (trans (cdr (assoc 10 LINE2)) 0 1))
(setq P4 (trans (cdr (assoc 11 LINE2)) 0 1))
(setq IN (inters P1 P2 P3 P4))
(setq BPT1 (polar IN AN (* AR 1)))
(setq BPT2 (polar IN (+ AN pi) (* AR 1)))
(command "_break" ENT1 BPT1 BPT2)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
) |
| 17 U L T I M E R I S P O S T E (in alto le più recenti) |
| arri |
Inserito il - 12 novembre 2014 : 13:16:29
ok
|
| Terminator |
Inserito il - 12 novembre 2014 : 12:43:31
No, non ho più sviluppato la cosa. |
| arri |
Inserito il - 12 novembre 2014 : 11:36:36
riprendo questa discussione per ringraziare nuovamente Terminator,
lisp utilissimo,
magari avevi qualche evoluzione ? |
| arri |
Inserito il - 07 gennaio 2013 : 12:37:12
Messaggio inserito da Terminator
L'evoluzione prevede, ovviamente, di verificare anche che tutti i vertici siano sullo stesso z...
magari in questa discussione esce qualche spunto
http://www.cadtutor.net/forum/showthread.php?76357-find-intersection-of-3D-lines |
| Terminator |
Inserito il - 04 gennaio 2013 : 11:45:48
L'evoluzione prevede, ovviamente, di verificare anche che tutti i vertici siano sullo stesso z... |
| arri |
Inserito il - 04 gennaio 2013 : 07:36:16
Messaggio inserito da Terminator
anche se, a questo punto, per tagliare la testa al toro, si convertono in lwpolyline prima del comando.
è come il primo lisp che funzionava solo con le linee,
in caso di polilinee prima le esplodevo...
è chiaro che ogni evoluzione è un regalo ben accetto
|
| Terminator |
Inserito il - 22 dicembre 2012 : 12:01:21
Arri aveva ragione, in certi casi non funziona.
Esaminando più attentamente ho notato che, quando un'entità 3dpoly viene spezzata, il valore (ssname gru index)non è più valido, a differenza delle altre entità che invece lo mantengono. Ci studierò su un momento anche se, a questo punto, per tagliare la testa al toro, si convertono in lwpolyline prima del comando.
Evidentemente il (ssname gru index) non veniva più utilizzato come entità da tagliare. |
| arri |
Inserito il - 21 dicembre 2012 : 08:49:20
Messaggio inserito da Terminator
E' molto strano ma a me funziona!
spezza solo una volta le poly, mentre le linee ok
;;; vers.2 - Selezione anche per lwpolyline e archi
(defun C:BKG (/ ar OS P1 P2 AN P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")) ; <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(princ "\nSelect entities to break: ")
(setq gru (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,ARC"))))
(if gru
(progn
(princ "\nSelect entities to cross over: ")
(while (not (setq gru2 (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,ARC")))))
(princ "\nNull Selection please try again: ")
)
(repeat (setq indexx(sslength gru2))
(setq entita (vlax-ename->vla-object(ssname gru2 (setq indexx(1- indexx)))))
(setq index 0)
(while (< index (sslength gru))
(setq inter(vla-IntersectWith entita (vlax-ename->vla-object(ssname gru index)) acExtendNone))
(if (ver-variant inter)
(progn
(setq distanzainter(vlax-curve-getDistAtPoint (vlax-ename->vla-object(ssname gru index)) (car(variant2lista inter 3))))
(setq BTP1(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (- distanzainter ar))
BTP2(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (+ distanzainter ar))
)
(command "_BREAK" (ssname gru index) btp1 btp2)
(ssadd (entlast) gru)
)
)
(setq index(1+ index))
)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
(princ "\nDigitare BKG per far partire il LISP")
(princ "\n ***** vers.2 by Terminator *****")
(princ)
;;; ***************************FUNZIONE VER-VARIANT*********************************
;;; Verifica che un variant non abbia contenuto nil
(defun ver-variant (listavariant / verifica)
(setq verifica (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value listavariant))))
(if (= (type verifica) 'LIST)
T
nil
)
)
;;; ***************************FUNZIONE VARIANT2LISTA*******************************
;;; Trasforma un variant in una lista a gruppi con numero elementi per gruppo
(defun variant2lista (listavariant numero / listaparz listafin)
(setq listaparz '()
listafin '()
)
(foreach elemento (vlax-safearray->list (vlax-variant-value listavariant))
(setq listaparz (append listaparz (list elemento)))
(if (= (length listaparz) numero)
(setq listafin (append listafin (list listaparz))
listaparz '()
)
)
)
listafin
)
|
| Terminator |
Inserito il - 21 dicembre 2012 : 08:12:39
| Messaggio inserito da arri
ho provato ad aggiungere anche POLYLINE (che nei dwg vecchi è molto presente) |
E' molto strano ma a me funziona! Al limite si potrebbe convertirle prima, almeno quelle che hanno uguale z per tutti i vertici.
|
| arri |
Inserito il - 21 dicembre 2012 : 07:55:48
Messaggio inserito da Terminator
Mi sembrava limitato il programma solo con la selezione delle linee e così l'ho integrato anche con lwpolyline e archi.
ho provato ad aggiungere anche POLYLINE (che nei dwg vecchi è molto presente)
(setq gru (ssget '((0 . "LINE,LWPOLYLINE,ARC,POLYLINE"))))
esperimento fallito !!! |
| arri |
Inserito il - 20 dicembre 2012 : 17:55:27
Messaggio inserito da Terminator
Mi sembrava limitato il programma solo con la selezione delle linee e così l'ho integrato anche con lwpolyline e archi.
;;; vers.2 - Selezione anche per lwpolyline e archi
(defun C:BKG (/ ar OS P1 P2 AN P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")) ; <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(princ "\nSelect entities to break: ")
(setq gru (ssget '((0 . "LINE,LWPOLYLINE,ARC"))))
(if gru
(progn
(princ "\nSelect entities to cross over: ")
(while (not (setq gru2 (ssget '((0 . "LINE,LWPOLYLINE,ARC")))))
(princ "\nNull Selection please try again: ")
)
(repeat (setq indexx(sslength gru2))
(setq entita (vlax-ename->vla-object(ssname gru2 (setq indexx(1- indexx)))))
(setq index 0)
(while (< index (sslength gru))
(setq inter(vla-IntersectWith entita (vlax-ename->vla-object(ssname gru index)) acExtendNone))
(if (ver-variant inter)
(progn
(setq distanzainter(vlax-curve-getDistAtPoint (vlax-ename->vla-object(ssname gru index)) (car(variant2lista inter 3))))
(setq BTP1(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (- distanzainter ar))
BTP2(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (+ distanzainter ar))
)
(command "_BREAK" (ssname gru index) btp1 btp2)
(ssadd (entlast) gru)
)
)
(setq index(1+ index))
)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
(princ "\nDigitare BKG per far partire il LISP")
(princ "\n ***** vers.2 by Terminator *****")
(princ)
;;; ***************************FUNZIONE VER-VARIANT*********************************
;;; Verifica che un variant non abbia contenuto nil
(defun ver-variant (listavariant / verifica)
(setq verifica (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value listavariant))))
(if (= (type verifica) 'LIST)
T
nil
)
)
;;; ***************************FUNZIONE VARIANT2LISTA*******************************
;;; Trasforma un variant in una lista a gruppi con numero elementi per gruppo
(defun variant2lista (listavariant numero / listaparz listafin)
(setq listaparz '()
listafin '()
)
(foreach elemento (vlax-safearray->list (vlax-variant-value listavariant))
(setq listaparz (append listaparz (list elemento)))
(if (= (length listaparz) numero)
(setq listafin (append listafin (list listaparz))
listaparz '()
)
)
)
listafin
)
ottimo !!!!!
Grazie Terminator
 |
| Terminator |
Inserito il - 20 dicembre 2012 : 16:53:05
Mi sembrava limitato il programma solo con la selezione delle linee e così l'ho integrato anche con lwpolyline e archi.
;;; vers.2 - Selezione anche per lwpolyline e archi
(defun C:BKG (/ ar OS P1 P2 AN P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")) ; <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(princ "\nSelect entities to break: ")
(setq gru (ssget '((0 . "LINE,LWPOLYLINE,ARC"))))
(if gru
(progn
(princ "\nSelect entities to cross over: ")
(while (not (setq gru2 (ssget '((0 . "LINE,LWPOLYLINE,ARC")))))
(princ "\nNull Selection please try again: ")
)
(repeat (setq indexx(sslength gru2))
(setq entita (vlax-ename->vla-object(ssname gru2 (setq indexx(1- indexx)))))
(setq index 0)
(while (< index (sslength gru))
(setq inter(vla-IntersectWith entita (vlax-ename->vla-object(ssname gru index)) acExtendNone))
(if (ver-variant inter)
(progn
(setq distanzainter(vlax-curve-getDistAtPoint (vlax-ename->vla-object(ssname gru index)) (car(variant2lista inter 3))))
(setq BTP1(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (- distanzainter ar))
BTP2(vlax-curve-getPointAtDist (vlax-ename->vla-object(ssname gru index)) (+ distanzainter ar))
)
(command "_BREAK" (ssname gru index) btp1 btp2)
(ssadd (entlast) gru)
)
)
(setq index(1+ index))
)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
(princ "\nDigitare BKG per far partire il LISP")
(princ "\n ***** vers.2 by Terminator *****")
(princ)
;;; ***************************FUNZIONE VER-VARIANT*********************************
;;; Verifica che un variant non abbia contenuto nil
(defun ver-variant (listavariant / verifica)
(setq verifica (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value listavariant))))
(if (= (type verifica) 'LIST)
T
nil
)
)
;;; ***************************FUNZIONE VARIANT2LISTA*******************************
;;; Trasforma un variant in una lista a gruppi con numero elementi per gruppo
(defun variant2lista (listavariant numero / listaparz listafin)
(setq listaparz '()
listafin '()
)
(foreach elemento (vlax-safearray->list (vlax-variant-value listavariant))
(setq listaparz (append listaparz (list elemento)))
(if (= (length listaparz) numero)
(setq listafin (append listafin (list listaparz))
listaparz '()
)
)
)
listafin
) |
| arri |
Inserito il - 19 dicembre 2012 : 16:59:41
Messaggio inserito da Terminator
(defun C:BKG (/ *ERROR* ar OS OL LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")) ; <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(setq OL (getvar "clayer"))
(princ "\nSelect lines to break: ")
(setq gru (ssget '((0 . "LINE"))))
(if gru
(progn
(princ "\nSelect lines to cross over: ")
(while (not (setq gru2 (ssget '((0 . "LINE")))))
(princ "\nNull Selection please try again: ")
)
(repeat (setq indexx(sslength gru2))
(setq LINE2 (entget (ssname gru2 (setq indexx(1- indexx)))))
(setq P3 (trans (cdr (assoc 10 LINE2)) 0 1))
(setq P4 (trans (cdr (assoc 11 LINE2)) 0 1))
(setq index 0)
(while (< index (sslength gru))
(setq LINE1 (entget (ssname gru index)))
(setq LN (cdr (assoc 8 LINE1)))
(setq P1 (trans (cdr (assoc 10 LINE1)) 0 1))
(setq P2 (trans (cdr (assoc 11 LINE1)) 0 1))
(setq AN (angle P1 P2))
(setq IN (inters P1 P2 P3 P4))
(if IN
(progn
(setq BPT1 (polar IN AN (* AR 1)))
(setq BPT2 (polar IN (+ AN pi) (* AR 1)))
(command "_break" (ssname gru index) BPT1 BPT2)
(ssadd (entlast) gru)
)
)
(setq index(1+ index))
)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
Questo è uno dei pochi casi in cui un gruppo di selezione con (ssget) aumenta di numero man mano che il comando va avanti.
Grazie Terminator
Funziona a meraviglia
|
| Terminator |
Inserito il - 19 dicembre 2012 : 15:12:37
(defun C:BKG (/ *ERROR* ar OS OL LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")) ; <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(setq OL (getvar "clayer"))
(princ "\nSelect lines to break: ")
(setq gru (ssget '((0 . "LINE"))))
(if gru
(progn
(princ "\nSelect lines to cross over: ")
(while (not (setq gru2 (ssget '((0 . "LINE")))))
(princ "\nNull Selection please try again: ")
)
(repeat (setq indexx(sslength gru2))
(setq LINE2 (entget (ssname gru2 (setq indexx(1- indexx)))))
(setq P3 (trans (cdr (assoc 10 LINE2)) 0 1))
(setq P4 (trans (cdr (assoc 11 LINE2)) 0 1))
(setq index 0)
(while (< index (sslength gru))
(setq LINE1 (entget (ssname gru index)))
(setq LN (cdr (assoc 8 LINE1)))
(setq P1 (trans (cdr (assoc 10 LINE1)) 0 1))
(setq P2 (trans (cdr (assoc 11 LINE1)) 0 1))
(setq AN (angle P1 P2))
(setq IN (inters P1 P2 P3 P4))
(if IN
(progn
(setq BPT1 (polar IN AN (* AR 1)))
(setq BPT2 (polar IN (+ AN pi) (* AR 1)))
(command "_break" (ssname gru index) BPT1 BPT2)
(ssadd (entlast) gru)
)
)
(setq index(1+ index))
)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
Questo è uno dei pochi casi in cui un gruppo di selezione con (ssget) aumenta di numero man mano che il comando va avanti. |
| arri |
Inserito il - 05 dicembre 2012 : 13:24:31
Messaggio inserito da Terminator
Senza voler strafare a tutti i costi mi sono limitato ad inserire la distanza non con getreal ma getdist. Ciò mi permette di selezionare una distanza anche a video, cosa non possibile con getreal.
La stessa distanza rimane disponibile le volte successive a basta invio per confermarla. Si poteva usare invece della funzione inters, la funzione vla-intersectwith, molto più completa e versatile della precedente e la gestione degli errori, ma a questo punto veniva fuori un altro programma.
(defun C:BKG (/ *ERROR* ar OS OL LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")); <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(setq OL (getvar "clayer"))
(princ "\nSelect crossing line to break: ")
(setq gru (ssget '((0 . "LINE"))))
(if gru
(progn
(while (not (setq ENT2 (car (entsel "\nSelect line to cross over: "))))
(princ "\nNull Selection please try again: ")
)
(setq LINE2 (entget ENT2))
(setq P3 (trans (cdr (assoc 10 LINE2)) 0 1))
(setq P4 (trans (cdr (assoc 11 LINE2)) 0 1))
(repeat (setq index(sslength gru))
(setq LINE1 (entget (ssname gru (setq index(1- index)))))
(setq LN (cdr (assoc 8 LINE1)))
(setq P1 (trans (cdr (assoc 10 LINE1)) 0 1))
(setq P2 (trans (cdr (assoc 11 LINE1)) 0 1))
(setq AN (angle P1 P2))
(setq IN (inters P1 P2 P3 P4))
(setq BPT1 (polar IN AN (* AR 1)))
(setq BPT2 (polar IN (+ AN pi) (* AR 1)))
(command "_break" (ssname gru index) BPT1 BPT2)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
)
Grazie Terminator
Collaudato, funziona perfettamente 
P.S.
il massimo sarebbe avere la selezione multipla anche sulla seconda richiesta Select line to cross over:
esempio 5 linee verticali da tagliare rispetto 10 linee orizzontali
- prima selezione -> 5 linee verticali
- seconda selezione -> 10 linee orizzontali
si eviterebbero 10 ripetizioni di sequenza comandi |
| Terminator |
Inserito il - 05 dicembre 2012 : 13:02:58
Senza voler strafare a tutti i costi mi sono limitato ad inserire la distanza non con getreal ma getdist. Ciò mi permette di selezionare una distanza anche a video, cosa non possibile con getreal.
La stessa distanza rimane disponibile le volte successive a basta invio per confermarla. Si poteva usare invece della funzione inters, la funzione vla-intersectwith, molto più completa e versatile della precedente e la gestione degli errori, ma a questo punto veniva fuori un altro programma.
(defun C:BKG (/ *ERROR* ar OS OL LINE1 LN P1 P2 AN LINE2 P3 P4 IN BPT1 PBT2)
(setvar "CMDECHO" 0)
(setq OS (getvar "osmode"))
(setvar "osmode" 0)
(princ "\nDistance of gap <")
(if (null ar1)
(setq ar1 0.00)
)
(princ ar1)
(setq ar (getdist ">: ")); <~~~~~~~~~~~~~~~~~~~~~~ Set your size of gap here!
(if (= ar nil)
(setq ar ar1)
)
(setq ar1 ar)
(setq OL (getvar "clayer"))
(princ "\nSelect crossing line to break: ")
(setq gru (ssget '((0 . "LINE"))))
(if gru
(progn
(while (not (setq ENT2 (car (entsel "\nSelect line to cross over: "))))
(princ "\nNull Selection please try again: ")
)
(setq LINE2 (entget ENT2))
(setq P3 (trans (cdr (assoc 10 LINE2)) 0 1))
(setq P4 (trans (cdr (assoc 11 LINE2)) 0 1))
(repeat (setq index(sslength gru))
(setq LINE1 (entget (ssname gru (setq index(1- index)))))
(setq LN (cdr (assoc 8 LINE1)))
(setq P1 (trans (cdr (assoc 10 LINE1)) 0 1))
(setq P2 (trans (cdr (assoc 11 LINE1)) 0 1))
(setq AN (angle P1 P2))
(setq IN (inters P1 P2 P3 P4))
(setq BPT1 (polar IN AN (* AR 1)))
(setq BPT2 (polar IN (+ AN pi) (* AR 1)))
(command "_break" (ssname gru index) BPT1 BPT2)
)
)
)
(setvar "osmode" 1)
(setq *error* nil)
(princ)
) |
| arri |
Inserito il - 05 dicembre 2012 : 08:01:27
per chi se la sente di apportare le modifiche,
sarebbe interessante la possibilità di selezionare prima tutte le linee da tagliare (ssget), e poi selezionare la linea di intersezione |
