+ Reply to Thread
Page 2 of 3 FirstFirst 1 2 3 LastLast
Results 11 to 20 of 24
  1. #11
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    Registered forum members do not see this ad.

    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.

    prec1.jpgprec2.jpg


    Hopefully this is not too complicated...

    Cheers!
    Attached Files

  2. #12
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Try something like this:

    Code:
    (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
    )
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  3. #13
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    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!

  4. #14
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    Hi Lee Mac,

    Final question about code:

    when you are using:

    Code:
    (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

  5. #15
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Quote Originally Posted by tomjas View Post
    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

    Quote Originally Posted by tomjas View Post
    Hi Lee Mac,

    Final question about code:

    when you are using:

    Code:
    (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
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  6. #16
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    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: <0>
    1
    2


    Specify Conversion Factor: <1>
    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?

  7. #17
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Something like this seems more intuitive to me:

    Code:
    (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)
      )
    )
    Last edited by Lee Mac; 16th Aug 2010 at 06:34 pm.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  8. #18
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    Hi Lee,

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

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

  9. #19
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    16,878

    Default

    Sorry Tom, I rushed it a bit and wrote it too quickly - I must've got the data types mixed up, a minor fix and code is now updated, please try it.

    Lee
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  10. #20
    Full Member
    Computer Details
    tomjas's Computer Details
    Operating System:
    XP
    Using
    AutoCAD 2010
    Join Date
    Jan 2010
    Location
    Leeds, UK
    Posts
    50

    Default

    Registered forum members do not see this ad.

    Lee- you are officially my own favorite Lisp Guru!

    Massive thank you for that!

    If you are interested – I’ve posted new thread. This time something challenging

    http://www.cadtutor.net/forum/showth...-Grid-involved!


    Cheers,
    Tom

Similar Threads

  1. LISP Program Renders Existing Blockreferences Undefined
    By LialAtArnold in forum AutoLISP, Visual LISP & DCL
    Replies: 0
    Last Post: 30th Jul 2010, 06:33 pm
  2. need help making addition to existing attribute block numbering lisp
    By mtreyger in forum AutoLISP, Visual LISP & DCL
    Replies: 10
    Last Post: 4th Jul 2010, 05:42 pm
  3. Modify Existing LISP - Lee Mac
    By AQucsaiJr in forum AutoLISP, Visual LISP & DCL
    Replies: 13
    Last Post: 26th Oct 2009, 04:20 am
  4. Text Field Lisp??
    By feargt in forum AutoLISP, Visual LISP & DCL
    Replies: 2
    Last Post: 29th Apr 2009, 07:35 am
  5. v 2004 Apply a default response to an existing lisp
    By ajs in forum AutoLISP, Visual LISP & DCL
    Replies: 11
    Last Post: 7th Nov 2007, 03:00 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts