Leaderboard
Popular Content
Showing content with the highest reputation on 06/17/2024 in all areas
-
1 point
-
(defun c:lgcheck ( / fuzz ss ssl i linelist speplist ent entlist sp ep spep speplistlen 1spep spepfilter spepfilterlen 1linelist ptlist linelistlen 1line ptlist_count linelist2 linelist2len catchstack 1stline netfilter 1net j linelist3 linelist3len targetline targetsp targetep) (setq fuzz 10) (if (setq ss (ssget '((0 . "LINE")))) (progn (setq ssl (sslength ss)) (setq i 0) (setq linelist '()) (setq speplist '()) (repeat ssl (setq ent (ssname ss i)) (setq entlist (entget ent)) (setq sp (cdr (assoc 10 entlist))) (setq ep (cdr (assoc 11 entlist))) (setq spep (vl-sort (list sp ep) (function (lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b)))))))) (setq linelist (cons (cons spep ent) linelist)) (setq speplist (cons spep speplist)) ; (setq ptlist (cons ep (cons sp ptlist))) (setq i (+ i 1)) ) (princ "\n line list before delete duplicate - ") (princ (length linelist)) (setq speplist (LM:Unique speplist)) (setq speplistlen (length speplist)) (setq i 0) (repeat speplistlen (setq 1spep (nth i speplist)) (setq spepfilter (massoc 1spep linelist)) (setq spepfilterlen (length spepfilter)) (if (> spepfilterlen 1) (progn (repeat (- spepfilterlen 1) (setq linelist (vl-remove (cons 1spep (car spepfilter)) linelist)) (entdel (car spepfilter)) (setq spepfilter (cdr spepfilter)) ) ) (progn ) ) (setq i (+ i 1)) ) (princ "\n line list after delete duplicate - ") (princ (length linelist)) (setq ptlist '()) (setq linelistlen (length linelist)) (setq i 0) (repeat linelistlen (setq 1line (nth i linelist)) (setq sp (car (car 1line))) (setq ep (cadr (car 1line))) (setq ptlist (cons ep (cons sp ptlist))) (setq i (+ i 1)) ) ;(princ linelist) ;(princ ptlist) ;(setq ptlist (vl-sort ptlist (function (lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b)))))))) (setq ptlist_count (LM:CountItems ptlist)) ;(princ ptlist_count) (setq i 0) (princ "\n line list before delete isolated - ") (princ (length linelist)) (setq linelist2 linelist) (repeat (length linelist) (setq 1line (nth i linelist)) (setq sp (car (car 1line))) (setq ep (cadr (car 1line))) (if (and (= 1 (cdr (assoc sp ptlist_count))) (= 1 (cdr (assoc ep ptlist_count)))) (progn (setq ptlist (vl-remove sp ptlist)) (setq ptlist (vl-remove ep ptlist)) (setq linelist2 (vl-remove 1line linelist2)) (_addline sp (list 0 0 0) 3) ) (progn ) ) (setq i (+ i 1)) ) (princ "\n line list after delete isolated - ") (princ (length linelist2)) (setq linelist2len (length linelist2)) ;(setq catchlist (list 1stline)) (setq catchstack '()) (while (> (length linelist2) 0) (setq 1stline (car linelist2)) (setq netfilter (list (car (car 1stline)) (cadr (car 1stline)))) ;(princ netfilter) (setq catchlist (list 1stline)) (setq linelist2 (cdr linelist2)) (while (> (length netfilter) 0) (setq 1net (car netfilter)) ;(princ "\n 1net - ") ;(princ 1net) (setq j 0) (setq linelist3 linelist2) (setq linelist3len (length linelist3)) (repeat linelist3len (setq targetline (car linelist3)) (setq targetsp (car (car targetline))) (setq targetep (cadr (car targetline))) (cond ((and (and (< (- (atof (vl-princ-to-string (car 1net))) fuzz) (atof (vl-princ-to-string (car targetsp)))) (< (atof (vl-princ-to-string (car targetsp))) (+ (atof (vl-princ-to-string (car 1net))) fuzz))) (and (< (- (atof (vl-princ-to-string (cadr 1net))) fuzz) (atof (vl-princ-to-string (cadr targetsp)))) (< (atof (vl-princ-to-string (cadr targetsp))) (+ (atof (vl-princ-to-string (cadr 1net))) fuzz))) (and (< (- (atof (vl-princ-to-string (caddr 1net))) fuzz) (atof (vl-princ-to-string (caddr targetsp)))) (< (atof (vl-princ-to-string (caddr targetsp))) (+ (atof (vl-princ-to-string (caddr 1net))) fuzz))) ) (setq netfilter (append netfilter (list targetep))) (setq catchlist (cons targetline catchlist)) (setq linelist2 (vl-remove targetline linelist2)) ) ((and (and (< (- (atof (vl-princ-to-string (car 1net))) fuzz) (atof (vl-princ-to-string (car targetep)))) (< (atof (vl-princ-to-string (car targetep))) (+ (atof (vl-princ-to-string (car 1net))) fuzz))) (and (< (- (atof (vl-princ-to-string (cadr 1net))) fuzz) (atof (vl-princ-to-string (cadr targetep)))) (< (atof (vl-princ-to-string (cadr targetep))) (+ (atof (vl-princ-to-string (cadr 1net))) fuzz))) (and (< (- (atof (vl-princ-to-string (caddr 1net))) fuzz) (atof (vl-princ-to-string (caddr targetep)))) (< (atof (vl-princ-to-string (caddr targetep))) (+ (atof (vl-princ-to-string (caddr 1net))) fuzz))) ) (setq netfilter (append netfilter (list targetsp))) (setq catchlist (cons targetline catchlist)) (setq linelist2 (vl-remove targetline linelist2)) ) (t ) ) (setq linelist3 (cdr linelist3)) ) (setq netfilter (cdr netfilter)) ) (setq catchstack (cons (list (length catchlist) catchlist) catchstack)) ) ;(princ "\n group - ") ;(princ catchstack) (princ "\n group count - ") (princ (length catchstack)) (setq catchstack (vl-sort catchstack (function (lambda (a b) (> (car a) (car b)))))) (setq i 0) (repeat (length catchstack) (setq 1group (cadr (nth i catchstack))) (setq 1grouplen (length 1group)) (setq j 0) (repeat 1grouplen (setq 1groupatomline (nth j 1group)) (setq 1groupatomename (cdr 1groupatomline)) (vlax-put-property (vlax-ename->vla-object 1groupatomename) 'color (+ i 1)) (setq j (+ j 1)) ) (setq i (+ i 1)) ) ) (progn ) ) (princ) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) ;; Count Items - Lee Mac ;; Returns a list of dotted pairs detailing the number of ;; occurrences of each item in a supplied list. (defun LM:CountItems ( l / c x ) (if (setq x (car l)) (progn (setq c (length l) l (vl-remove x (cdr l)) ) (cons (cons x (- c (length l))) (LM:CountItems l)) ) ) ) (defun massoc ( key lst / itm ) (if (setq itm (assoc key lst)) (cons (cdr itm) (massoc key (cdr (member itm lst)))) ) ) (defun _addline (startpt endpt col) (entmakex (apply 'append (list (list '(0 . "LINE") (cons 100 "AcDbEntity") ;(cons 8 layer) (cons 100 "AcDbLine") (cons 62 col) (cons 10 startpt) (cons 11 endpt) ) ) ) ) ) I thought about it over the weekend and tried to solve my homework. thanks for reply. This is used to check the integrity of the nodes and edges for the dijkstra algorithm for 3d route and points Drawing1.dwg1 point
-
posted this make main selection of lines set Lastent as place holder run Join command lines that can will be joined. (tho now that i look at some of your examples might not work as intended) process newly created entitys (grouped lines that are now polylines?) into a new selection set SS2 foreach poly in SS2 set Lastent as place holder explode poly process newly created entitys back to lines to a new selection set set a random color Back to what you posted I think dxf 10 and 11 are like 15 decimal places and I had a hard time matching things with out adding a fuzz distance if you go that route pull the entity name also all at once (Entity (SPT) (EPT)) and then use some lambda magic to find the ones that are touching. NM already did it https://www.lee-mac.com/chainsel.html1 point
-
You can find 3D flanges at the CADforum. Look under the heading CAD +BIM Blocks > Piping, P&ID > Pipes > Flanges.1 point
-
They only have smaller sizes (less than 12" IIRC) at McMaster-Carr, if you need larger sizes you'll need another source or make your own. I use them on the rare occasion I have a smaller pipe, and often for fasteners and other items. I also have had better luck with downloading the Soldworks models and importing those into AutoCAD (AFAIK they use Solidworks to create the 3D models, I called and asked them a long time ago). But, mostly any of them work fine. How to use Solidworks files in AutoCAD (autodesk.com) Importing a STEP file into AutoCAD Products (autodesk.com) How to Import a CAD STEP File into your AutoCad Software (youtube.com) I use a 2D flange LISP and create my own by Extruding them. ANSI B16.5 Flanges Lisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net) ANSI B16.47 Flanges Lisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net) Also, I haven't used these in a while, but Cad / 3D Flange Drawings - Texas Flange go up to 144".1 point
-
1 point
-
These may be useful examples. (command "erase" (ssget "X" '((0 . "IMAGE"))) "") (command "imageattach" (strcat "D:\\acadtemp\\" img) pt 1000 0)1 point