Jump to content

Recommended Posts

Posted

Well, you could have mentioned that.

 

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

  • Replies 44
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    13

  • spasobn

    12

  • VAC

    7

  • m4rdy

    2

Top Posters In This Topic

Posted Images

Posted

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

Posted

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.:cry:

Posted

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

Posted

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

ASD-2010-Table.jpg

Posted

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

Posted

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

thank you.

 

m4rdy

  • 11 months later...
Posted

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. :unsure:

Posted

Mike,

 

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

  • 2 years later...
Posted (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 by Misko78
typo
  • 2 weeks later...
  • 4 months later...
Posted

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.2013-05-17_114033.jpg

  • 2 years later...
Posted

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

  • 2 years later...
Posted

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

  • 2 weeks later...
Posted

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

 

 

Posted (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 by ronjonp
added link
  • 7 months later...
Posted

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

 

 

Posted

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?

Posted (edited)

Change:

(vlax-3d-point (trans '(0 0 1) 0 1))

To:

(vlax-3d-point (trans (getvar 'viewdir) 1 0 T))

 

Edited by Roy_043

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...