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" ) ) ) ) (initget (LM:lst->str (mapcar 'car convLst) " ")) (setq unit (assoc (cond ( (getkword (strcat "\nSpecify Unit [" (LM:lst->str (mapcar 'car 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 "%%)." 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) ))
| 
