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

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

    Registered forum members do not see this ad.

    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
    Attached Files

  2. #2
    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,789

    Default

    So you want user to select a block and the field to display the block name? Is this at all related to the hatch?
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

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

  3. #3
    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,

    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

  4. #4
    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,789

    Default

    Try this:

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

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

  5. #5
    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’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

  6. #6
    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 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):
    Code:
    (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!

  7. #7
    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,789

    Default

    Correct, you would just change the property that the field is pointing to. I check that the object is a block in the test statement for the WHILE function
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

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

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

    Default

    And is working

    I've changed
    Code:
    (eq "INSERT" (cdr (assoc 0 (entget x))))
    to
    Code:
    (eq "POINT" (cdr (assoc 0 (entget x))))
    and EffectiveName to Coordinates and is creating label with coordinates of selected point

    Now...

    as you know there are some 'parameters' in
    AcObjProp Object(%<\\_ObjId>%).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!

  9. #9
    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,789

    Default

    Certainly, I'm happy that you are willing learn from the code, rather than use it blindly.

    I'll post a generic example in a bit
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

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

  10. #10
    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,789

    Default

    Registered forum members do not see this ad.

    Take a look at this Tom:

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

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

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