Leaderboard

Use Lee Mac's Minimum Bounding Box!

HA! I knew I had written something for this but couldn't find it!

exceed welcome to use this Have you looked at ( setq colnum (acad_colordlg 1) pick any color probably what I would use saves need more defuns. or (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (ah:butts but "V" '("Choose a color" "yellow" "green" "cyan" "blue" "magenta" "white" "gray" "light" "gray" "purple")) ; the variable BUT inside the code holds the button selected value can use that for this post Multi GETVALS.lsp

mhupp its possibly better to leave d as a number can use equal with fuzz factor or = for most cases. (rtos 1.2 2 2) "1.2" (rtos 0.0 2 2 ) "0" (rtos 0.0000000001 2 2 ) "0"

Glad to help, it was easy to find as I've probably got as much of your code referenced in my CUIX as you do! I enjoy writing lisp as well but time is money. Anytime Google can find a quick solution online from a guru I trust it's added to my collection referenced to where and from whom I got it! Thanks again,

Then don't quote me asking for additional features. And again: Have you tried to solve this yourself?

Try this code by ronjonp http://www.theswamp.org/index.php?topic=49865.msg551018#msg551018 I modified it slightly for my needs from his http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417

msg me this list. (defun c:blknames () (setq blklst (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for blk blklst (and (eq "AcDbBlockReference" (vla-get-ObjectName blk))) (setq lst (cons (vla-get-Name blk) lst)) ) lst ) maybe *Model_Space and *Paper_Space are Different in Autocad.

Just assumed the blocks only had Attributes. cleaned up the cod a bit no real need to need to test for attributes. (defun C:rin2 (/ e o p d entlst blkname) (vl-load-com) (setvar 'errno 0) (and vlax-get-acad-object (while (/= 52 (getvar 'errno)) (setq e (car (nentsel "\nSelect text to fill: "))) (cond ((= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString))) (princ "\nThis is not a text object.") (setq e nil) ) ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true)) (princ "\nThis object is on a locked layer.") (setq e nil) ) (e (if (and (setq p (getpoint "\nSpecify first point: ")) (setq p (cons p (list (getpoint "\nSpecify second point: " p)))) (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0))) ) (cond ((<= d 0.009) (vla-put-textstring o (substr (rtos d 2 3) 1 4)) ) (t (vla-put-textstring o (substr (rtos d 2 3) 1 4)) (vla-put-Color o 2) (if (and (setq blkname (cdr (assoc 2 (entget (cdr (assoc 330 (entget e))))))) (/= blkname "*Model_Space")) ;get parent block entname (progn (setq obj (tblobjname "block" blkname)) (while (setq obj (entnext obj)) (setq entlst (cons obj entlst)) ) (foreach ent entlst (vla-put-Color (vlax-ename->vla-object ent) 2) ) ) ) ) ) (setvar 'errno 52) ) ) (T nil) ) (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ; regen to update block ) ) (princ) )

I don't see how that is updating. If an attribute is inside a block it shows up to me as "ATTRIB" I had to change "ATTDEF" to that and vla-put-Tagstring to vla-put-textstring. (defun C:rin2 (/ e o p d) (vl-load-com) (setvar 'errno 0) (and vlax-get-acad-object (while (/= 52 (getvar 'errno)) (setq e (car (nentsel "\nSelect text to fill: "))) (cond ((= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString))) (princ "\nThis is not a text object.") (setq e nil) ) ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true)) (princ "\nThis object is on a locked layer.") (setq e nil) ) (e (if (and (setq p (getpoint "\nSpecify first point: ")) (setq p (cons p (list (getpoint "\nSpecify second point: " p)))) (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0))) ) (cond ((and (= "ATTRIB" (cdr (assoc 0 (entget e)))) (<= d 0.009)) (vla-put-TextString o (rtos d 2 2)) ) ((= "ATTRIB" (cdr (assoc 0 (entget e)))) (vla-put-TextString o (rtos d 2 2)) (vla-put-Color o 2) (if (setq ent (tblobjname "block" (cdr (assoc 2 (entget (cdr (assoc 330 (entget e)))))))) ;get parent block entname (while (setq ent (entnext ent)) (setq entlst (cons ent entlst)) ) ) (foreach ent entlst (vla-put-Color (vlax-ename->vla-object ent) 2) ) (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports) ; regen to update block ) ((<= d 0.009) (vla-put-TextString o (rtos d 2 2)) ) (t (vla-put-textstring o (rtos d 2 2)) (vla-put-Color o 2) ) ) ) (setvar 'errno 52) ) (T nil) ) ) ) (princ) )

@exceed Syntax incorrect of (vl-catch-all-apply 'vla-get obj aa). Try (vl-catch-all-apply (function vla-get) (list obj aa))

Your right if you going to do a job do it right the fist time. (defun C:rin2 (/ e o p d) (vl-load-com) (setvar 'errno 0) (and vlax-get-acad-object (while (/= 52 (getvar 'errno)) (setq e (car (nentsel "\nSelect text to fill: "))) (cond ((= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) ) ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString))) (princ "\nThis is not a text object.") (setq e nil) ) ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true)) (princ "\nThis object is on a locked layer.") (setq e nil) ) (e (if (and (setq p (getpoint "\nSpecify first point: ")) (setq p (cons p (list (getpoint "\nSpecify second point: " p)))) (setq d (abs (/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))) 1000.0))) ) (cond ((and (= "ATTDEF" (cdr (assoc 0 (entget e)))) (<= d 0.009)) (vla-put-TagString o (rtos d 2 2)) ) ((= "ATTDEF" (cdr (assoc 0 (entget e)))) (vla-put-TagString o (rtos d 2 2)) (vla-put-Color o 2) ) ((<= d 0.009) (vla-put-TextString o (rtos d 2 2)) ) (t (vla-put-textstring o (rtos d 2 2)) (vla-put-Color o 2) ) ) ) (setvar 'errno 52) ) (T nil) ) ) ) (princ) )

You can sort of get at vl properties, you would need a list of what you want to look for. eg Circle has radius and Center point (vlax-property-available-p obj 'radius) returns true for a circle or arc. So a list may start with ("objectName" "Layer" and so on "Radius" "Length" "Circumference" ..........

@mhupp FWIW ;; This (setq ss (ssget "_X" '((8 . "0") (-4 . "<NOT") (0 . "INSERT") (-4 . "NOT>") (410 . "Model")))) ;; Is the same as this (setq ss (ssget "_X" '((8 . "0") (0 . "~INSERT") (410 . "Model"))))

update the Cond (cond ((and (= "ATTDEF" (cdr (assoc 0 (entget e)))) (/= d "0.00")) (vla-put-TagString o d) (vla-put-Color o 2) ) ((= "ATTDEF" (cdr (assoc 0 (entget e)))) (vla-put-TagString o d) ) ((/= d "0.00") (vla-put-TextString o d) (vla-put-Color o 2) ) (t (vla-put-TagString o d) ) )

I read your post as a text over a pline not a text length to pline GIf helps will try the resize GIf will see if can reset before making.

Just run the same macro to exit.