Jump to content

Block's name to FIELD (based on existing lisp)


tomjas

Recommended Posts

Hi there,

 

Another idea :)

 

Can anybody help me to modify existing lisp (by Lee Mac- lisp is great, thank you), please?

Right now lisp is creating text field with area value of selected hatch...

 

I would like to modify it so user can create 'label'=field with name value of selected block (dynamic and not dynamic). I was trying to change this code, but once again without success...

 

Lisp attached.

 

Thank you in advance.

 

Cheers,

Tom

a2f.lsp

Link to comment
Share on other sites

  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • tomjas

    12

  • Lee Mac

    10

  • Brockster

    1

  • saikoduri

    1

Top Posters In This Topic

Posted Images

Hi Lee Mac,

 

That was a quick replay :)

 

No is not related to the hatch, BUT. Before I managed to modify it so instead of hatch it was creating label with length value of selected pline...

I thought this will be similar as instead of referring to AcDbHatch Area- this will refer to something like AcDbBlock Name (I don't even know how to refer to blocks). I've tried that but is not working...

 

I have massive collection of blocks and I would like to create a 'label' next to each single one with name of the block... All blocks are in one cad file, that's why I need to see which block is which...

Of course there is no need to ask user about conversion factor or unit type here, only text height and pick block and pick point to create 'label=field'.

 

I'll really appreciate if you can help me!

 

Regards,

Tom

Link to comment
Share on other sites

Try this:

 

(defun c:FieldBlockName ( / *error* doc spc e p )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (LM:ActiveSpace 'doc 'spc)

 (while
   (and
     (setq e
       (LM:SelectifFoo
         (lambda ( x )
           (eq "INSERT" (cdr (assoc 0 (entget x))))
         )
         "\nSelect Block: "
       )
     )
     (setq p (getpoint "\nPick Point for Field: "))
   )
   (LM:AddMText_MC spc p
     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
       (LM:GetObjectID doc (vlax-ename->vla-object e)) ">%).EffectiveName>%"
     )
   )
 )

 (princ)
)

(defun LM:AddMText_MC ( space pt str / o )
 ;; © Lee Mac 2010
 (setq o (vla-AddMtext space (vlax-3D-point pt) 0. str))
 (vla-put-AttachmentPoint o acAttachmentPointMiddleCenter)
 (vla-put-InsertionPoint o (vlax-3D-point pt))
)

(defun LM:GetObjectID ( doc obj )
 ;; © Lee Mac 2010
 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
   (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
   (itoa (vla-get-Objectid obj))
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Select if Foo }==--------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - predicate function taking ename argument            ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:SelectifFoo ( foo str / sel ent )
 ;; © Lee Mac 2010
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

Link to comment
Share on other sites

I’m going to be honest with you Lee. You are GREAT!

 

I have no idea how you are doing this, but this is absolutely fantastic!

 

Thanks a lot again!

Cheers,

Tom

Link to comment
Share on other sites

I have a question. I’ve tried to understand your code...

 

 

I can’t see where you are referring to block (for picking object id). Before you were using AcDbHatch (for hatch id) but I can’t see this one now... Is it working for any object now and then depends what value you want to show, you are changing (i.e):

(LM:GetObjectID doc (vlax-ename->vla-object e)) ">%).EffectiveName>%"

?

 

 

Please see screenshots below.

Field_11-20-02.jpg

Field_11-20-34.jpg

So my question is: if I would like to modify it so want to create label with coordinates of selected point, do I have to change only .EffectiveName to .Coordinates?

 

Sorry for problems, but I want to understand it rather than bother you every single time

 

Thanks a lot!

Link to comment
Share on other sites

And is working :D

 

I've changed

(eq "[color=Red][b]INSERT[/b][/color]" (cdr (assoc 0 (entget x))))

to

(eq "[color=Red]POINT[/color]" (cdr (assoc 0 (entget x))))

and EffectiveName to Coordinates and is creating label with coordinates of selected point :shock:

 

Now...

 

as you know there are some 'parameters' in

AcObjProp Object(%%).coordinates \f "%lu2%pr1">%

 

responsible for units, precision and other stuff...

 

Is there any way (and by any way I mean simply to understand, edit, change for other type i.e. from %pr to %tu)

to add some options for user to sett, as you did for lisp about hatches on top of this post.

I've tried to copy some code to this lisp to ask user to declare units and precision... of course without success.

 

So as you did with this code- I was able to understand most of it and change it so is picking different object and returning different value...

 

So let say for point coordinates, I want user to declare units and precision, so %lu and %pr but later I'll create other lisp (copy) and ask user to declare suffix %ps for length value of selected pline. I would like to know what to change and where (do I have to declare different variable for different stuff?) to be able to do that.

 

Would it be possible to add this option to code, please?

 

I've done some programming in c++ years ago on uni, but I can't remember much. But at least I can understand some of your code instead of asking you every single time for new stuff.

 

Sorry for all those problems, but it's great to learn something from you!

Link to comment
Share on other sites

Take a look at this Tom:

 

(defun c:MakeField ( / *error* object property units prec pref suff conv doc spc e p )
 (vl-load-com)
 ;; © Lee Mac 2010

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;;                                                                               ;;
;;                                Adjustments                                    ;;
;;                                                                               ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (setq object   "INSERT"         ;; Object Type (cannot be nil)

       property "InsertionPoint" ;; Field Property (must belong to object, else field = #### )

       units     2               ;; Units (integer: 1-6 or nil)

       prec      3               ;; Precision (integer: 0-8 or nil)

       pref     "Lee"            ;; Prefix (string or nil)

       suff     "Mac"            ;; Suffix (string or nil)

       conv      nil             ;; Conversion Factor (real or nil)

 )

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (LM:ActiveSpace 'doc 'spc)

 (while
   (and
     (setq e
       (LM:SelectifFoo
         (lambda ( x )
           (eq object (cdr (assoc 0 (entget x))))
         )
         (strcat "\nSelect " object ": ")
       )
     )
     (setq p (getpoint "\nPick Point for Field: "))
   )
   (LM:AddMText_MC spc p
     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
       (LM:GetObjectID doc (vlax-ename->vla-object e)) ">%)." property
       (if (apply 'or (list units prec conv pref suff))
         (strcat " \\f \""
           (if units (strcat "%lu" (itoa units)) "")
           (if prec  (strcat "%pr" (itoa prec )) "")
           (if (or pref suff) (strcat "%ps[" (cond ( pref ) ( "" )) "," (cond ( suff ) ( "" )) "]") "")
           (if conv  (strcat "%ct8[" (rtos conv) "]") "")
           "\""
         )
         ""
       )
       ">%"
     )
   )
 )

 (princ)
)

(defun LM:AddMText_MC ( space pt str / obj )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq obj
         (vl-catch-all-apply (function vla-AddMText)
           (list space (vlax-3D-point pt) 0. str)
         )
       )
     )
   )
   (progn
     (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter)
     (vla-put-InsertionPoint obj (vlax-3D-point pt))
   )
 )
)

(defun LM:GetObjectID ( doc obj )
 ;; © Lee Mac 2010
 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
   (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
   (itoa (vla-get-Objectid obj))
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Select if Foo }==--------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - predicate function taking ename argument            ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:SelectifFoo ( foo str / sel ent )
 ;; © Lee Mac 2010
 (while
   (progn
     (setq sel (entsel str))
     
     (cond
       (
         (vl-consp sel)

         (if (not (foo (setq ent (car sel))))
           (princ "\n** Invalid Object Selected **")
         )
       )
     )
   )
 )
 ent
)

 

I have included quite a few 'adjustments' at the top of the code - obviously this doesn't include them all, but I wanted to give an idea..

 

Most error trapping regarding using the correct field code values is left to the user.

Link to comment
Share on other sites

This is fantastic! So easy to understand and modify!

 

 

I’ve added another variable ‘zvalue’ so for point coordinates you can decide to show X,Y,Z or only X,Y

 

If I can ask you for 2 last options, please:

 

 

 

  1. Add code (in the same easy to understand and modify way) to ask user do define values for let say prec and suff, where asking for prec user have only options to choose (like drop down menu with numbers 0-4 but no chance to type different value- see graphics below). And for suff user can type anything or if left empty will be nil.
  2. Add IF function- so let say for point coordinates I want ask user: “Show Z value?” and user have 2 options Yes and No. If Yes – variable zvalue will be 3, if No- zvalue will be nil.

 

prec2.jpg

 

 

Hopefully this is not too complicated...o:)

 

Cheers!

prec1.jpg

makefield-POINT.lsp

Link to comment
Share on other sites

Try something like this:

 

(defun c:MakeField ( / *error* object property units prec pref suff zval conv doc spc e p )
 (vl-load-com)
 ;; © Lee Mac 2010

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;;                                                                               ;;
;;                                Adjustments                                    ;;
;;                                                                               ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (setq object   "INSERT"         ;; Object Type (cannot be nil)

       property "InsertionPoint" ;; Field Property (must belong to object, else field = #### )

       units     2               ;; Units (integer: 1-6 or nil)

       prec      3               ;; Precision (integer: 0-8 or nil)

       pref     "Lee"            ;; Prefix (string or nil)

       suff     "Mac"            ;; Suffix (string or nil)

       conv      nil             ;; Conversion Factor (real or nil)

       zval      t               ;; Hide Z-Vale (t or nil)

 )

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (LM:ActiveSpace 'doc 'spc)

 (while (not (<= 0 (setq prec (cond ( (getint "\nSpecify Precision [0/1/2/3/4] <0> : ") ) ( 0 ))) 4))
   (princ "\n** Precision Must be Between 0 and 4 **")
 )

 (setq suff ( (lambda ( v ) (cond ( (eq "" v) nil ) ( v ))) (getstring t "\nSuffix <None> : ")))

 (initget "Yes No")
 (setq zval (eq "Yes" (getkword "\nHide Z-Value? [Yes/No] <No> : ")))

 (while
   (and
     (setq e
       (LM:SelectifFoo
         (lambda ( x )
           (eq object (cdr (assoc 0 (entget x))))
         )
         (strcat "\nSelect " object ": ")
       )
     )
     (setq p (getpoint "\nPick Point for Field: "))
   )
   (LM:AddMText_MC spc p
     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
       (LM:GetObjectID doc (vlax-ename->vla-object e)) ">%)." property
       (if (apply 'or (list units prec conv pref suff))
         (strcat " \\f \""
           (if units (strcat "%lu" (itoa units)) "")
           (if zval  "%pt3" "")
           (if prec  (strcat "%pr" (itoa prec )) "")
           (if (or pref suff) (strcat "%ps[" (cond ( pref ) ( "" )) "," (cond ( suff ) ( "" )) "]") "")
           (if conv  (strcat "%ct8[" (rtos conv) "]") "")
           "\""
         )
         ""
       )
       ">%"
     )
   )
 )

 (princ)
)

(defun LM:AddMText_MC ( space pt str / obj )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq obj
         (vl-catch-all-apply (function vla-AddMText)
           (list space (vlax-3D-point pt) 0. str)
         )
       )
     )
   )
   (progn
     (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter)
     (vla-put-InsertionPoint obj (vlax-3D-point pt))
   )
 )
)

(defun LM:GetObjectID ( doc obj )
 ;; © Lee Mac 2010
 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
   (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
   (itoa (vla-get-Objectid obj))
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Select if Foo }==--------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - predicate function taking ename argument            ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:SelectifFoo ( foo str / e )
 ;; © Lee Mac 2010
 (while
   (progn
     (setq e (car (entsel str)))
     
     (cond
       (
         (eq 'ENAME (type e))

         (if (not (foo e)) (princ "\n** Invalid Object Selected **"))
       )
     )
   )
 )
 e
)

Link to comment
Share on other sites

This is excellent piece of work! Working perfectly, easy to understand for someone without lisp programming skills and easy to customise it to my needs!

 

THANK YOU!

Link to comment
Share on other sites

Hi Lee Mac,

 

Final question about code:

 

when you are using:

 

(while (not (<= 0 (setq prec (cond ( (getint "\nSpecify Precision [0/1/2/3/4] <0> : ") ) ( 0 ))) 4))
   (princ "\n** Precision Must be Between 0 and 4 **")
 )

is there any way to show something like graphic below but still get value of selected number so I can imagine that part [0/1/2/3/4] must be edited but how to insert some text here when this is responsible for returning value?

 

Graphic1.jpg

 

Thanks

Link to comment
Share on other sites

This is excellent piece of work! Working perfectly, easy to understand for someone without lisp programming skills and easy to customise it to my needs!

 

THANK YOU!

 

You're quite welcome Tom :)

 

Hi Lee Mac,

 

Final question about code:

 

when you are using:

 

(while (not (<= 0 (setq prec (cond ( (getint "\nSpecify Precision [0/1/2/3/4] <0> : ") ) ( 0 ))) 4))
   (princ "\n** Precision Must be Between 0 and 4 **")
 )

is there any way to show something like graphic below but still get value of selected number so I can imagine that part [0/1/2/3/4] must be edited but how to insert some text here when this is responsible for returning value?

 

I have used the getint function prompt for an integer, hence the function accepts an integer input, not a string. You can quite easily alter the string prompt to display as you posted, but the entry would have still have to be a number.

 

Lee

Link to comment
Share on other sites

I've just spent 2 days trying to work it out and I'm stuck

 

What I want to do is create a label with area value of selected hatch- so is a modification of lisp attached as a first one.

 

Lisp should be like that:

 

Specify Precision:

1

2

 

Specify Conversion Factor:

0.0001 (m2 ->ha)

0.000001 (m2->km2)

 

And another tricky part here with suffix. If user selected 1 for conversion factor, suffix should be m2. If 0.0001- suffix ha, 0.000001- suffix km2. Don't want to ask user about suffix- just depends with conversion factor, suffix will be there.

 

I'm really fed up- I've sorted one thing, other is not working... Seems to be really simple, but after 2 days...

 

Can you help, please?

Link to comment
Share on other sites

Something like this seems more intuitive to me:

 

(defun c:MakeField ( / *error* object convlst property units prec pref suff zval conv doc spc e p unit )
 (vl-load-com)
 ;; © Lee Mac 2010

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;;                                                                               ;;
;;                                Adjustments                                    ;;
;;                                                                               ;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (setq object   "HATCH"          ;; Object Type (cannot be nil)

       property "Area"           ;; Field Property (must belong to object, else field = #### )

       units     2               ;; Units (integer: 1-6 or nil)

       prec      3               ;; Precision (integer: 0-8 or nil)

       pref      nil             ;; Prefix (string or nil)

       suff      nil             ;; Suffix (string or nil)

       conv      nil             ;; Conversion Factor (real or nil)

       zval      nil             ;; Hide Z-Vale (t or nil)

 )

 (setq convLst '(("m²" . 1) ("ha" . 0.0001) ("km²" . 0.000001)))

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;

 (defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (LM:ActiveSpace 'doc 'spc)

 (initget "0 1 2")
 (setq prec
   (atoi
     (cond
       (
         (getkword "\nSpecify Precision [0/1/2] <0> : ")
       )
       ( "0" )
     )
   )
 )

 (initget (LM:lst->str (mapcar 'car convLst) " "))
 (setq unit
   (assoc
     (cond
       (
         (getkword
           (strcat "\nSpecify Unit ["
             (LM:lst->str (mapcar 'car convLst) "/") "] <" (caar convLst) "> : "
           )
         )
       )
       ( (caar convLst) )
     )
     convLst
   )
 )

 (setq suff (car unit) conv (cdr unit))

 (while
   (and
     (setq e
       (LM:SelectifFoo
         (lambda ( x )
           (eq object (cdr (assoc 0 (entget x))))
         )
         (strcat "\nSelect " object ": ")
       )
     )
     (setq p (getpoint "\nPick Point for Field: "))
   )
   (LM:AddMText_MC spc p
     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
       (LM:GetObjectID doc (vlax-ename->vla-object e)) ">%)." property
       (if (apply 'or (list units prec conv pref suff))
         (strcat " \\f \""
           (if units (strcat "%lu" (itoa units)) "")
           (if zval  "%pt3" "")
           (if prec  (strcat "%pr" (itoa prec )) "")
           (if (or pref suff) (strcat "%ps[" (cond ( pref ) ( "" )) "," (cond ( suff ) ( "" )) "]") "")
           (if conv  (strcat "%ct8[" (rtos conv) "]") "")
           "\""
         )
         ""
       )
       ">%"
     )
   )
 )

 (princ)
)

(defun LM:AddMText_MC ( space pt str / obj )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq obj
         (vl-catch-all-apply (function vla-AddMText)
           (list space (vlax-3D-point pt) 0. str)
         )
       )
     )
   )
   (progn
     (vla-put-AttachmentPoint obj acAttachmentPointMiddleCenter)
     (vla-put-InsertionPoint obj (vlax-3D-point pt))
   )
 )
)

(defun LM:GetObjectID ( doc obj )
 ;; © Lee Mac 2010
 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
   (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
   (itoa (vla-get-Objectid obj))
 )
)

;;--------------------=={ ActiveSpace }==---------------------;;
;;                                                            ;;
;;  Retrieves pointers to the Active Document and Space       ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  *doc - quoted symbol other than *doc                      ;;
;;  *spc - quoted symbol other than *spc                      ;;
;;------------------------------------------------------------;;

(defun LM:ActiveSpace ( *doc *spc )
 ;; © Lee Mac 2010
 (set *spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (set *doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace (eval *doc)))
     )
     (vla-get-ModelSpace (eval *doc))
     (vla-get-PaperSpace (eval *doc))
   )
 )
)

;;-------------------=={ Select if Foo }==--------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - predicate function taking ename argument            ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:SelectifFoo ( foo str / e )
 ;; © Lee Mac 2010
 (while
   (progn
     (setq e (car (entsel str)))
     
     (cond
       (
         (eq 'ENAME (type e))

         (if (not (foo e)) (princ "\n** Invalid Object Selected **"))
       )
     )
   )
 )
 e
)

;;-------------------=={ List to String }==-------------------;;
;;                                                            ;;
;;  Constructs a string from a list of strings separating     ;;
;;  each element by a specified delimiter                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  lst - a list of strings to process                        ;;
;;  del - delimiter by which to separate each list element    ;;
;;------------------------------------------------------------;;
;;  Returns:  String containing each string in the list       ;;
;;------------------------------------------------------------;;

(defun LM:lst->str ( lst del )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
 )
)

Edited by Lee Mac
Link to comment
Share on other sites

Hi Lee,

 

This is magic and you're right- this is more intuitive :D

 

The only small problem is when asked for precision (is 0 set as default because black dot is next to 0?) and user hit Enter- there is a error: ** Error: bad argument type: stringp 0 **

Is working fine when user is clicking 0 from the list.

 

Is there any easy way to fix it, please?

 

Once again- thank you very much. This is far better than I expected....

Link to comment
Share on other sites

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