Lee Mac Posted July 12, 2009 Posted July 12, 2009 Well, you could have mentioned that. While we are at it, any other settings? Like Prefix/Suffix? Quote
Lee Mac Posted July 12, 2009 Posted July 12, 2009 Its not really too hard. Try this: ;; Put Field in Cell, by Lee McDonnell 11.07.2009 (defun c:putfld (/ *error* doc spc chx ent Obj tStr flag grdat gr dat osPt tss lst row col) (vl-load-com) (defun *error* (msg) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")) (princ "\n*Cancel*")) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) ; Vport (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *mac (setq *mac "Select")) (initget "Select Polyline") (setq chx (getkword (strcat "\nSelect Object or Draw Polyline [sel/Poly] <" *mac "> : "))) (or (not chx) (setq *mac chx)) (cond ((eq "Select" *mac) (while (progn (setq ent (car (entsel "\nSelect Object: "))) (cond ((eq 'ENAME (type ent)) (if (not (and (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area) (vlax-property-available-p Obj 'Length))) (princ "\n** Invalid Object Selected **"))) (t (princ "\n** Nothing Selected **")))))) ((eq "Polyline" *mac) (command "_.pline") (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command pause)) (setq Obj (vlax-ename->vla-object (entlast))))) (if Obj (progn (repeat 2 (setq tStr (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (vl-princ-to-string (vla-get-Objectid Obj)) ">%)." (if flag "Length" "Area") " \\f \"%lu2%pr2%ct8[" (if flag "0.01" "0.0001") "]\">%")) (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) 0 tStr)) (vla-put-visible tObj :vlax-false) (princ (strcat "\nPlace " (if flag "Length" "Area") " Field...")) (while (progn (setq grdat (grread t 15 0) gr (car grdat) dat (cadr grdat)) (cond ((and (eq 5 gr) (listp dat)) (redraw) (vla-put-visible tObj :vlax-true) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap dat (osLst (getvar "OSMODE"))))) (progn (osMark osPt) (setq dat osPt))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point dat)) t) ((eq 2 gr) (cond ((vl-position dat '(32 13)) nil) ((eq 6 dat) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))))) (t t))) ((eq 25 gr) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) nil) ((eq 3 gr) (if (and (setq tss (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (car (vl-remove-if 'null (mapcar (function (lambda (tab) (if (eq :vlax-true (vla-HitTest tab (vlax-3D-point (trans dat 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list tab row col)))) (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex tss)))))))) (and (not (apply 'vla-SetText (append lst (list tStr)))) tObj (not (vlax-erased-p tObj)) (vla-delete tObj))) nil) (t t)))) (setq flag T)))) (princ)) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Quote
spasobn Posted July 14, 2009 Author Posted July 14, 2009 There are no loop for each Room (Object). It would be good to not call putfld for each Room, instead Select Object, place A and L, select another Object, place A and L etc. I tried to put loop but with no success. Quote
Lee Mac Posted July 14, 2009 Posted July 14, 2009 How about this: ;; Put Field in Cell, by Lee McDonnell 11.07.2009 (defun c:putfld (/ *error* doc spc chx ent Obj tStr flag grdat gr dat osPt tss lst row col) (vl-load-com) (defun *error* (msg) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")) (princ "\n*Cancel*")) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) ; Vport (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *mac (setq *mac "Select")) (while (progn (initget "Select Polyline Quit") (setq chx (getkword (strcat "\nSelect Object or Draw Polyline [sel/Poly/Quit] <" *mac "> : "))) (or (not chx) (setq *mac chx)) (setq flag nil) (cond ((eq "Quit" nil)) (t (cond ((eq "Select" *mac) (while (progn (setq ent (car (entsel "\nSelect Object: "))) (cond ((eq 'ENAME (type ent)) (if (not (and (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area) (vlax-property-available-p Obj 'Length))) (princ "\n** Invalid Object Selected **"))) (t (princ "\n** Nothing Selected **")))))) ((eq "Polyline" *mac) (command "_.pline") (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command pause)) (setq Obj (vlax-ename->vla-object (entlast))))) (if Obj (progn (repeat 2 (setq tStr (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (vl-princ-to-string (vla-get-Objectid Obj)) ">%)." (if flag "Length" "Area") " \\f \"%lu2%pr2%ct8[" (if flag "0.01" "0.0001") "]\">%")) (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) 0 tStr)) (vla-put-visible tObj :vlax-false) (princ (strcat "\nPlace " (if flag "Length" "Area") " Field...")) (while (progn (setq grdat (grread t 15 0) gr (car grdat) dat (cadr grdat)) (cond ((and (eq 5 gr) (listp dat)) (redraw) (vla-put-visible tObj :vlax-true) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap dat (osLst (getvar "OSMODE"))))) (progn (osMark osPt) (setq dat osPt))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point dat)) t) ((eq 2 gr) (cond ((vl-position dat '(32 13)) nil) ((eq 6 dat) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))))) (t t))) ((eq 25 gr) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) nil) ((eq 3 gr) (if (and (setq tss (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (car (vl-remove-if 'null (mapcar (function (lambda (tab) (if (eq :vlax-true (vla-HitTest tab (vlax-3D-point (trans dat 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list tab row col)))) (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex tss)))))))) (and (not (apply 'vla-SetText (append lst (list tStr)))) tObj (not (vlax-erased-p tObj)) (vla-delete tObj))) nil) (t t)))) (setq flag T)))))))) (princ)) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Quote
m4rdy Posted July 21, 2009 Posted July 21, 2009 Mr Lee Mac, How do we copy polyline entities with length segment to table like Autocad Structural Detailing? (Attached image is from Autocad Structural Detailing - reinforcement). Thank you. m4rdy Quote
Lee Mac Posted July 21, 2009 Posted July 21, 2009 Are you saying you just want a length field inserted into a cell? Quote
m4rdy Posted July 22, 2009 Posted July 22, 2009 I meant inserting polyline object into table cell (see table i've attached with yellow color). thank you. m4rdy Quote
MikeZ_CSI Posted July 14, 2010 Posted July 14, 2010 Lee Mac, can you help me with a slight variation to your scell Lisp, I would like to be able to select fields, that being a "named object" or what ever field value you click on that is currently in the drawing. I've tried to vary your code with no luck. Quote
Lee Mac Posted July 14, 2010 Posted July 14, 2010 Mike, Your query may be better suited to a new thread with a full description of your goal. Quote
Misko78 Posted December 18, 2012 Posted December 18, 2012 (edited) Hello everyone, I've tried to use this to automate area and lenght input into tables but always get #### in cell. What am i doing wrong? Edited December 18, 2012 by Misko78 typo Quote
075 Posted May 17, 2013 Posted May 17, 2013 Hi, Nice to meet you I was very interesting with this lisp but unfortunetaly, I have some trouble with it. It works perfectly but at the end the field in the cell does'nt write the area. Please be kind to help me to understand why. Thanks a lot. Quote
zicoman Posted May 2, 2016 Posted May 2, 2016 The lisp working in autocad 2007 any idea how to get it work in autocad 2014? Thanks ;; Put Field in Cell, by Lee McDonnell 11.07.2009 (defun c:putfld (/ *error* doc spc chx ent Obj tStr flag grdat gr dat osPt tss lst row col) (vl-load-com) (defun *error* (msg) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")) (princ "\n*Cancel*")) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) ; Vport (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *mac (setq *mac "Select")) (while (progn (initget "Select Polyline Quit") (setq chx (getkword (strcat "\nSelect Object or Draw Polyline [sel/Poly/Quit] <" *mac "> : "))) (or (not chx) (setq *mac chx)) (setq flag nil) (cond ((eq "Quit" nil)) (t (cond ((eq "Select" *mac) (while (progn (setq ent (car (entsel "\nSelect Object: "))) (cond ((eq 'ENAME (type ent)) (if (not (and (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area) (vlax-property-available-p Obj 'Length))) (princ "\n** Invalid Object Selected **"))) (t (princ "\n** Nothing Selected **")))))) ((eq "Polyline" *mac) (command "_.pline") (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command pause)) (setq Obj (vlax-ename->vla-object (entlast))))) (if Obj (progn (repeat 2 (setq tStr (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (vl-princ-to-string (vla-get-Objectid Obj)) ">%)." (if flag "Length" "Area") " \\f \"%lu2%pr2%ct8[" (if flag "0.001" "0.000001") "]\">%")) (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) 0 tStr)) (vla-put-visible tObj :vlax-false) (princ (strcat "\nPlace " (if flag "Length" "Area") " Field...")) (while (progn (setq grdat (grread t 15 0) gr (car grdat) dat (cadr grdat)) (cond ((and (eq 5 gr) (listp dat)) (redraw) (vla-put-visible tObj :vlax-true) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap dat (osLst (getvar "OSMODE"))))) (progn (osMark osPt) (setq dat osPt))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point dat)) t) ((eq 2 gr) (cond ((vl-position dat '(32 13)) nil) ((eq 6 dat) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))))) (t t))) ((eq 25 gr) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) nil) ((eq 3 gr) (if (and (setq tss (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (car (vl-remove-if 'null (mapcar (function (lambda (tab) (if (eq :vlax-true (vla-HitTest tab (vlax-3D-point (trans dat 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list tab row col)))) (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex tss)))))))) (and (not (apply 'vla-SetText (append lst (list tStr)))) tObj (not (vlax-erased-p tObj)) (vla-delete tObj))) nil) (t t)))) (setq flag T)))))))) (princ)) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Quote
VAC Posted September 2, 2018 Posted September 2, 2018 Hi, is it possible to do update of the script? I was using script "sCell" in ACAD2012, but after update to ACAD2014,then 2016,2018, it does not work and I have no way back to older version 2012. We start a new project with over 4thousand rooms, so I can not imagine doing it without this tool. I estimate it will be in part when inserting to table, because it shows "no cell selected" when I click to the cell. Please, please, help. Many thanks Quote
VAC Posted September 13, 2018 Posted September 13, 2018 Hi, nobody can do update or get information which command is in new version of ACAD (2014 or newer) not supported or changed? Code is not too long to find it, if anybody understand it. I don´t. Please help. (defun c:sCell (/ tab ent Obj pt tObj row col) (vl-load-com) (if (and (setq tab (car (entsel "\nSelect Table: "))) (eq "ACAD_TABLE" (cdr (assoc 0 (entget tab))))) (while (and (setq ent (car (entsel "\nSelect Room: "))) (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area)) (while (progn (setq pt (getpoint "\nClick into Cell to place field: ")) (cond ((vl-consp pt) (if (eq :vlax-true (vla-hittest (setq tObj (vlax-ename->vla-object tab)) (vlax-3D-point pt) (vlax-3D-point (trans '(0 0 1) 0 1)) 'row 'col)) nil (princ "\n** No Cell Selected **"))) (t (princ "\n** No Point Selected **"))))) (vla-setText tObj row col (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string (vla-get-Objectid Obj)) ">%).Area \\f \"%lu2%pr2\">%"))) (princ "\n** No Table Selected **")) (princ)) Quote
ronjonp Posted September 13, 2018 Posted September 13, 2018 (edited) Do a search for 'LM:objectid' and replace: (vl-princ-to-string (vla-get-Objectid Obj)) with (LM:objectid obj) Question: If you have a project with 4000 rooms why are you still picking these one at a time? Edited September 13, 2018 by ronjonp added link Quote
VAC Posted April 25, 2019 Posted April 25, 2019 Hi, I update my script according to "ronjonp". It is working on ACAD2014, but not on ACAD2016. Nothing is inserted to table cell - it ends with "** No Cell Selected **" when trying to click on the cell. Why? Could anybody help me? Thank you (defun c:sCell (/ tab ent Obj pt tObj row col) (vl-load-com) (if (and (setq tab (car (entsel "\nSelect Table: "))) (eq "ACAD_TABLE" (cdr (assoc 0 (entget tab))))) (while (and (setq ent (car (entsel "\nSelect Room: "))) (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area)) (while (progn (setq pt (getpoint "\nClick into Cell to place field: ")) (cond ((vl-consp pt) (if (eq :vlax-true (vla-hittest (setq tObj (vlax-ename->vla-object tab)) (vlax-3D-point pt) (vlax-3D-point (trans '(0 0 1) 0 1)) 'row 'col)) nil (princ "\n** No Cell Selected **"))) (t (princ "\n** No Point Selected **"))))) (vla-setText tObj row col (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object ent)) ">%).Area \\f \"%lu2%pr2%ds44%ct8[1e-006]\">%"))) (princ "\n** No Table Selected **")) (princ)) ;; ObjectID - Lee Mac ;; Returns a string containing the ObjectID of a supplied VLA-Object ;; Compatible with 32-bit & 64-bit systems (defun LM:objectid ( obj ) (eval (list 'defun 'LM:objectid '( obj ) (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring) (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false) '(LM:ename->objectid (vlax-vla-object->ename obj)) ) '(itoa (vla-get-objectid obj)) ) ) ) (LM:objectid obj) ) ;; Entity Name to ObjectID - Lee Mac ;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name (defun LM:ename->objectid ( ent ) (LM:hex->decstr (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent)) ent (substr ent (+ (vl-string-position 58 ent) 3)) ) ) ) ;; Hex to Decimal String - Lee Mac ;; Returns the decimal representation of a supplied hexadecimal string (defun LM:hex->decstr ( hex / foo bar ) (defun foo ( lst rtn ) (if lst (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn)) (apply 'strcat (mapcar 'itoa (reverse rtn))) ) ) (defun bar ( int lst ) (if lst (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst)) (cons (rem int 10) (bar (/ int 10) (cdr lst))) ) (bar int '(0)) ) ) (foo (vl-string->list (strcase hex)) nil) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) Quote
VAC Posted April 26, 2019 Posted April 26, 2019 Hi again. I today find out, that the script is OK on both versions ACAD, but does not function when the drawing is swaped to local system. It works only in global coordinate system (UCS). Why? Is there solution? Quote
Roy_043 Posted April 26, 2019 Posted April 26, 2019 (edited) Change: (vlax-3d-point (trans '(0 0 1) 0 1)) To: (vlax-3d-point (trans (getvar 'viewdir) 1 0 T)) Edited April 26, 2019 by Roy_043 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.