Leaderboard

If you are only selecting blocks change (cdr (assoc 1 (entget e))) to (cdr (assoc 2 (entget e)))

I would recommend you draw all the dimensions first (rotated or aligned), then upon executing the command, select all the dimensions, and AutoLISP will determine all common intersecting points. Here's my solution for you: ;; Get arrowhead location for the dimension --> Jonathan Handojo ;; dim - dimension entity ;; Returns a list of two points denoting the arrowhead location (defun JH:getarrowpt (dim / dimang pt1 pt2 pt3 pt4) (setq dimang (angle (setq pt1 (cdr (assoc 10 (entget dim)))) (setq pt2 (cdr (assoc 11 (entget dim)))) ) ) (list (inters pt1 pt2 (setq pt3 (cdr (assoc 13 (entget dim)))) (polar pt3 (+ (* 0.5 pi) dimang) 1) nil ) (inters pt1 pt2 (setq pt4 (cdr (assoc 14 (entget dim)))) (polar pt4 (+ (* 0.5 pi) dimang) 1) nil ) ) ) ;; Gets a list of duplicated points with a certain fuzz in a list of points ;; lst - list of points to check for ;; fuz - tolerance between points ;; Returns a list of duplicate points (defun JH:commonpts (lst fuz / tst rtn) (while lst (setq tst (car lst) lst (cdr lst) ) (if (and (vl-some '(lambda (x) (equal tst x fuz) ) lst ) (not (vl-some '(lambda (x) (equal tst x fuz) ) rtn ) ) ) (setq rtn (cons tst rtn)) ) ) (reverse rtn) ) ;; ------------------------------------------- ;; (defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list. (setq iter 0) (repeat (sslength selset) (setq lst (cons (ssname selset iter) lst) iter (1+ iter)) ) (reverse lst) ) ;; ------------------------------------------- ;; (defun c:putblk ( / *error* activeundo acadobj adoc arrpt blk DegToRad fuz msp rot ss) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (defun DegToRad (x) (* x (/ pi 180))) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (setq ss (ssget '((0 . "DIMENSION"))) blk "Tem_Sense" ; <--- Block name to insert fuz 1e-4 ; <--- Intersection tolerance ) (if ss (progn (setq arrpt (apply 'append (mapcar 'JH:getarrowpt (JH:selset-to-list ss))) rot (progn (initget 1) (getreal "\nSpecify rotation in degrees: ")) ) (if (tblsearch "BLOCK" blk) (mapcar '(lambda (x) (vla-InsertBlock msp (apply 'vlax-3d-point x) blk 1 1 1 (DegToRad rot)) ) (JH:commonpts arrpt fuz) ) ) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) )

I've now updated my Auto Label Attributes program to account for this - please download the new version from my site.

Try this (defun c:b1 ( /) (pedwid 50.0 "_beams layer")) (defun c:b2 ( /) (pedwid 100.0 "_beams layer")) (defun c:b3 ( /) (pedwid 200.0 "_beams layer")) (defun pedwid (wid lay / entis ) (while (setq ent (car (entsel "\nPick an object to make pline width:"))) (setq entis (cdr (assoc 0 (entget ent)))) (cond ((= entis "LINE")(command "Pedit" ent "Y" "w" wid "")) ((= entis "ARC")(command "Pedit" ent "Y" "w" wid "")) (if (= entis "LWPOLYLINE")(command "Pedit" ent "w" wid "")) ((Alert "Object chosen can not be made into a pline")) ) (command "chprop" (entlast) "" "LA" lay "") ) (princ) )

Thank you rlx - I always appreciate your help

Please try the following: (defun c:exnest ( / doc ent ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (/= "INSERT" (cdr (assoc 0 (entget ent)))) (princ "\nSelected object is not a block.") ) ) ) ) (if ent (progn (vlax-for obj (vla-item (vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (LM:name->effectivename (cdr (assoc 2 (entget ent)))) ) (exnest:explode obj) ) (vla-regen doc acallviewports) ) ) (princ) ) (defun exnest:explode ( obj / lst ) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (vlax-write-enabled-p obj) (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode))))) ) (progn (foreach obj lst (exnest:explode obj)) (vla-delete obj) ) ) ) ;; Block Name -> Effective Block Name - Lee Mac ;; blk - [str] Block name (defun LM:name->effectivename ( blk / rep ) (if (and (wcmatch blk "`**") (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag") ) ) ) ) (setq rep (handent (cdr (assoc 1005 rep)))) ) (cdr (assoc 2 (entget rep))) blk ) ) (vl-load-com) (princ)