Leaderboard

if you need all object you cad do it with just delete '((0 . ~~~)) (setq ss (ssget '((0 . "LWPOLYLINE")(8 . "WALL")))) (setq ss (ssget '((8 . "WALL")))) or you want all of layer (setq ss (ssget)) and also ss1 (setq ss1 (ssget "F" co-ord (list (cons 0 "LINE,LWPOLYLINE,ARC,CIRCLE,POINT,TEXT,MTEXT,insert")))) (setq ss1 (ssget "F" co-ord)) If you want to exclude wall layer from the selected objects (setq ss1 (ssget "F" co-ord '((-4 . "<NOT") (8 . "WALL") (-4 . "NOT>"))))

(defun c:gass ( / cl clt ltypename layername) (setq ltypename "GASs") (setq layername "PIPELINES") (setq clt (getvar "CELTYPE")) ; Get active linetype (if (not (tblsearch "LTYPE" ltypename)) ; If linetype does not exist (command "_-linetype" "_l" ltypename "truba.lin" "_s" ltypename "") ; Create it ) (if (/= (getvar "CELTYPE") ltypename) ; If linetype is not active (setvar "CELTYPE" ltypename) ; Activate it ) (setq cl (getvar "clayer")) ; Get active layer (if (not (tblsearch "LTYPE" layername)) ; If layer does not exist (command "_-layer" "_m" layername "") ; Create it ) (if (/= (getvar "CLAYER") layername) ; If layer is not active (setvar "CLAYER" layername) ; Activate it ) (command "_pline") ; Start command (while (= (getvar "cmdactive") 1) ; As long as command is active, pause (command "\\") ) (setvar "CELTYPE" clt) ; Activate it (setvar "CLAYER" cl) ; Reset layer to what it was before this function ) I've added some comments, hopefully this makes it more clear what is happening. And it would make a nice challenge to fix the second one yourself

I believe you can export and then import your profile among other settings. How to export, import, backup, and transfer settings to and from AutoCAD (autodesk.com)

Wouldn't you know it. I figured it out after posting this and it took a few extra "minutes" to figure out the block insertion with attributes soooo... Here's the 'working' code: (defun c:setupint (/ mspc ss_txt ss_lines pntlst grdlst attlst i_pnt i_grd ob_pnt ob_grd pnt1 pnt2 pnt3 ob_strg blk idx1 idx2 obj1 obj2 attlstfinal atts ) (setq mspc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (princ "\nSelect Grid Text: ") ;start and ;grid text prompt (setq ss_txt (ssget '((0 . "TEXT,MTEXT")))) ;filter text objects of grid (princ "\nSelect Grid Lines: ") ;grid lines prompt (setq ss_lines (ssget '((0 . "LINE")))) ;filter line objects of grid (setq pntlst (SF:sortyx (LM:intersectionsinset ss_lines))) ;list of intersection points of grid lines (setq grdlst (MT:GrdAcList ss_lines ss_txt)) ;list of grid lines with associated text ) ;end and (repeat (setq i_pnt (length pntlst)) ;start repeat point (setq ob_pnt (nth (setq i_pnt (1- i_pnt)) pntlst)) ;set variable for intersection point (repeat (setq i_grd (length grdlst)) ;start repeat grid (setq ob_grd (nth (setq i_grd (1- i_grd)) grdlst) ;set variable for line object with string pnt1 ob_pnt ;intersection point pnt2 (vlax-curve-getStartPoint (cadr ob_grd)) ;1st point on line object pnt3 (vlax-curve-getEndPoint (cadr ob_grd)) ;2nd point on line object ob_strg (car ob_grd) ;line object's associated string/text ) (if (LM:Collinear-p pnt1 pnt2 pnt3) ;collinear check - line vs intersection point (setq attlst (cons (list ob_pnt ob_strg) attlst)) ;list of text with corresponding point ) ) ;end repeat grid ) ;end repeat point ) (repeat (setq idx1 (length attlst)) (setq obj1 (nth (setq idx1 (1- idx1)) attlst)) (repeat (setq idx2 idx1) (setq obj2 (nth (setq idx2 (1- idx2)) attlst)) (if (= (nth 0 (car obj1)) (nth 0 (car obj2))) (setq attlstfinal (cons (list (nth 0 obj1) (nth 1 obj1) (nth 1 obj2)) attlstfinal)) ) ) ) (foreach itm attlstfinal (setq p (list (nth 0 (car itm)) (nth 1 (car itm)) (nth 2 (car itm)))) (setq blk (vla-insertblock mspc (vlax-3D-point p) "setupint" 1.0 1.0 1.0 0)) (foreach atts (vlax-invoke blk 'GetAttributes) (if (= (vla-get-Tagstring atts) "GRID_INT_VERT") (vla-put-textstring atts (nth 1 itm)) ) (if (= (vla-get-Tagstring atts) "GRID_INT_HORZ") (vla-put-textstring atts (nth 2 itm)) ) ) ) (vl-load-com) (princ) ) ;; Grid Association List - Generates Listed Pairs of Grid Line with intersecting Grid Text (defun MT:GrdAcList (ssl sst / i_txt i_line ob_txt ob_line rtn strg) (repeat (setq i_line (sslength ssl)) (setq ob_line (vlax-ename->vla-object (ssname ssl (setq i_line (1- i_line))))) (repeat (setq i_txt (sslength sst)) (setq ob_txt (vlax-ename->vla-object (ssname sst (setq i_txt (1- i_txt)))) strg (vla-get-TextString ob_txt) ) (if (/= nil (LM:intersections ob_line ob_txt acextendthisentity)) (setq rtn (cons (list (vl-princ-to-string (read strg)) ob_line) rtn)) ) ) ) ) ;; Intersections in Set - Lee Mac ;; Returns a list of all points of intersection between all objects in a supplied selection set. ;; sel - [sel] Selection Set (defun LM:intersectionsinset (sel / id1 id2 ob1 ob2 rtn) (repeat (setq id1 (sslength sel)) (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1))))) (repeat (setq id2 id1) (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2)))) rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn) ) ) ) (apply 'append (reverse rtn)) ) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections (ob1 ob2 mod / lst rtn) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;; Collinear-p - Lee Mac ;; Returns T if p1,p2,p3 are collinear (defun LM:Collinear-p (p1 p2 p3) ((lambda (a b c) (or (equal (+ a b) c 0.001) (equal (+ b c) a 0.001) (equal (+ c a) b 0.001) ) ) (distance p1 p2) (distance p2 p3) (distance p1 p3) ) ) ;;Sorts Intersection Point List by Y then X (defun SF:sortYX (ptlist / yvals newptlist) (foreach pt ptlist (if (not (vl-remove-if-not '(lambda (y) (equal (cadr pt) y 0.0001)) yvals)) (setq yvals (cons (cadr pt) yvals)) ) ; end if ) ; end foreach (setq yvals (vl-sort yvals '(lambda (y1 y2) (< y1 y2)))) ; sort from least to greatest (foreach yval yvals (setq pts (vl-remove-if-not '(lambda (pt) (equal yval (cadr pt) 0.0001)) ptlist) pts (vl-sort pts '(lambda (pt1 pt2) (< (car pt1) (car pt2)))) newptlist (append newptlist pts) ) ; end setq ) ; end foreach newptlist ) ; end defun Lots of subfunctions (thanks Lee Mac and other sources) but it works. I'm sure this could be cleaned up and/or simplified a good bit. I'd like to still see suggestions if anyone has any. After I finalize a few more bells and whistles, I'll fully comment this thing and post my completed lisp in case anyone else can use it or even learn from it, maybe.