Fill table cells with fields

[Lee Mac]

Well, you could have mentioned that.

 

While we are at it, any other settings? Like Prefix/Suffix?

[spasobn]

Mac, nothing else matters.

[Lee Mac]

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)))))

[spasobn]

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.

[Lee Mac]

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)))))

[m4rdy]

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

[Lee Mac]

Are you saying you just want a length field inserted into a cell?

[m4rdy]

I meant inserting polyline object into table cell (see table i've attached with yellow color).

thank you.

 

m4rdy

[MikeZ_CSI]

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.

[Lee Mac]

Mike,

 

Your query may be better suited to a new thread with a full description of your goal.

[Misko78]

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

[paulfillion]

Lee, this is very nice!!!

[075]

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.

[zicoman]

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)))))

[VAC]

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

[VAC]

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))

 

 

[ronjonp]

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

[VAC]

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)
)

 

 

[VAC]

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?

[Roy_043]

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