LISP to change UCS during Mleader command

[ODO18]

Trying to create a few lisps so users can dimension, mtext, and mleader without changing UCS along with a few other options I am building in.  This lisp below the UCS is on view for the initial leader selection point, but it will immediately change back to UCS previous after that first selection and most importantly before you get to place the text.  The text is all that matters for the UCS change.

This is the LISP that works fine except the UCS:

(defun c:ALeader ( / *error* mldr)

(command "-layer" "t" "E-S-T-DIM"
"on" "E-S-T-DIM" "")

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(if cec (setvar 'cecolor cec))
(if cel (setvar 'celtype cel))
(if cly (setvar 'clayer cly))
(if osm (setvar 'osmode osm))
(command-s "_.ucs" "p")
(princ))

(setq cec (getvar 'cecolor)
cel (getvar 'celtype)
cly (getvar 'clayer)
osm (getvar 'osmode))
(if (tblsearch "layer" "E-S-T-DIM")
(setvar "clayer" "E-S-T-DIM")
(command "-layer" "M" "E-S-T-DIM" "C" "white" "" "L" "Continuous" "" ""))
(setvar "cecolor" "bylayer")
(setvar "celtype" "bylayer")
(setvar "osmode" 1)
(command "ucs" "v")
(command "mleader" "o" "m" "0" "x")
(command pause)
(*error* "end")
)

[hencoop]

@ODO18 If all you need the UCS for is to place the MLeader horizontal to the view, you can skip the UCS and do this instead:

          (VLAX-PUT-PROPERTY
            mleaderobj
            'TextRotation
            (- 0 (GETVAR "VIEWTWIST"))
          )

Here is what I wrote to handle dimensions.

It makes dimension text right-reading relative to horizontal in the view.  There are a few places in the code where I set the UCS, place the dimension, and then reset the UCS which you may be able to use as examples.  Rather that cut snippets and miss something key to the method, I posted the entire code (except subroutines which are external).  If you need or want any of the external subroutines used just let me know and I'll post them for you:

;;;
;;;
;;;	Author:
;;;		Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;
;;;     http://paracadd.com
;;;	All rights reserved.
;;;
;;;	Copyright:  
;;;	   Edited:  
;;;****************************************************************************
(DEFUN dimucs_error (msg /)
  (PRINC (STRCAT "\nError: " msg))
  (PRINC "\nDIMUCS aborted: A UCS may still be active! ")
  (IF releaseObjects (releaseObjects (LIST '*acad-object* '*active-document*)))
  (IF old_dimucsosmode
    (SETVAR "OSMODE" old_dimucsosmode)
  ) ;_ end of IF
  (IF old_dimucscmdecho
    (SETVAR "CMDECHO" old_dimucscmdecho)
  ) ;_ end of IF
  (SETQ *error* orig_dimucs_error)
  (PRINC)
) ;_ end of DEFUN
;;;****************************************************************************
(DEFUN C:DIMUCS (/ rwdimpt_1 rwdimpt_2 rwdimpt_3 podimpt_1 podimpt_2 podimpt_3)
  (vl-load-com)
  (IF (EQ (GETVAR "TILEMODE") 0)
    (PROGN
      (IF active-document
        (active-document)
        (SETQ *active-document* (vla-get-Activedocument (vlax-get-Acad-Object)))
      )
      (vla-put-MSpace *active-document* :vlax-true)
      (SETQ the-dimscale (GETVAR "DIMSCALE"))
      (IF (/= the-dimscale 0)
        (PROGN
          (SETVAR "DIMSCALE" 0)
          (PRINC (STRCAT "\nDIMSCALE was " (RTOS the-dimscale 2 1) " and has been set to 0. "))
          (PRINC)
        )
      )
      (IF releaseObjects (releaseObjects (LIST '*acad-object* '*active-document*)))
    )
    (PROGN
      (IF dimscl NIL (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! "))
      (dimscl)
      (SETQ the-dimscale dimsc)
    )
  )
  (SETQ orig_dimucs_error
         *error*
        *error* dimucs_error
  ) ;_ end of SETQ
  (SETQ old_dimucsosmode (GETVAR "OSMODE"))
  (SETVAR "OSMODE" 0)
  (SETQ old_dimucscmdecho (GETVAR "CMDECHO"))
  (SETVAR "CMDECHO" 0)
  (COMMAND ".UCS" "W")
  (IF c:tsnap
    NIL
    (LOAD "tsnap" "\nFile TSNAP.LSP not loaded! ")
  ) ;_ end of IF
  (C:TSNAP)
  (IF c:svlayr
    NIL
    (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded! ")
  ) ;_ end of IF
  (IF ustr
    NIL
    (LOAD "ustr" "\nFile USTR.LSP not loaded! ")
  ) ;_ end of IF
  (IF ukword
    NIL
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of IF
  (IF gvpno
    NIL
    (LOAD "gvpno" "\nFile GVPNO.LSP not loaded! ")
  ) ;_ end of IF
  (c:svlayr)
  (SETQ dimucs_prec (IF dimucs_prec dimucs_prec 0))
  (WHILE
      (EQ
        (SETQ txtopts
               (ukword
                 1
                 "STacked-row+p Row+p PE Tce PIpe Min Fixed PRecision"
                 (STRCAT
                   "dimension STacked row+pipe; Row+pipe; Permanent Easement; Tce; Pipe; Min-pipe; or Fixed: [STacked-row+p/Row+p/PE/Tce/PIpe/Min/Fixed/PRecision] "
                   "(precision=" (ITOA dimucs_prec)")"
                 )
                 (IF txtopts
                   txtopts
                   "Row+p"
                 ) ;_ end of IF
               ) ;_ end of ukword
        ) ;_ end of SETQ
        "PRecision"
      )
      (SETQ dimucs_prec (uint 1 "" "Dimension Precision: " (IF dimucs_prec dimucs_prec 0)))
  )
  (IF (EQ txtopts "STacked-row+p")
    (SETQ ;txtopts "Row+p"
          stack_rwtxt T
    )
  )
  (IF (EQ txtopts "Row+p")
    (SETQ txtopts "Row+p"
          stack_rwtxt NIL
    )
  )
  (IF (EQ txtopts "Fixed")
    (SETQ fixedtxt (ustr 1
                         "Enter fixed text for aligned dimension"
                         fixedtxt
                         T
                   ) ;_ end of ustr
    ) ;_ end of SETQ
  ) ;_ end of IF
  (IF (EQ txtopts "PE")
    (PROGN
      (IF C:ENGRLDRS NIL (LOAD "ENGRLDRS" "\nFile ENGRLDRS.LSP not loaded! "))
      (C:ENGRLDRS)
      (COMMAND ".UCS" "V")
    ) ;_ end of PROGN
    (PROGN
      (IF C:ENGRDIMS NIL (LOAD "ENGRDIMS" "\nFile ENGRDIMS.LSP not loaded! "))
      (C:ENGRDIMS)
      (COMMAND ".UCS"
               "3P"
               (GETVAR "VIEWCTR")
               (POLAR (GETVAR "VIEWCTR")
                      (+ (GETVAR "SNAPANG") (/ PI 8.0))
                      100
               ) ;_ end of POLAR
               (POLAR (GETVAR "VIEWCTR")
                      (+ (GETVAR "SNAPANG") (/ PI 8.0) (/ PI 2.0))
                      100
               ) ;_ end of POLAR
      ) ;_ end of COMMAND
    ) ;_ end of PROGN
  ) ;_ end of IF
  (COMMAND ".UCSICON" "ON")
  (SETVAR "SNAPANG" 0)
  (IF c:engrdims
    NIL
    (LOAD "engrdims" "\nFile ENGRDIMS.LSP not loaded! ")
  ) ;_ end of IF
  (IF c:engrldrs
    NIL
    (LOAD "engrldrs" "\nFile ENGRLDRS.LSP not loaded! ")
  ) ;_ end of IF
  (SETQ mjrg  "C"
        llt   "-"
        colr  "1"
        colra NIL
        colri NIL
        modf  "DIMS"
  ) ;_ end of SETQ
  (gvpno)
  (c:mklayr)
  (COND
    ((WCMATCH txtopts "Row+p,STacked-row+p")
     (SETQ dimopts "R/W")
    )
    ((EQ txtopts "PE")
     (SETQ dimopts "PERMANENT EASEMENT")
     (SETQ ease_type (ustr 1 (STRCAT "Type of " (STRCASE dimopts T) "?") (IF ease_type ease_type "UTILITY") T))
    )
    ((EQ txtopts "Tce")
     (SETQ dimopts "TEMPORARY CONSTRUCTION EASEMENT")
    )
    ((OR(EQ txtopts "PIpe")(EQ txtopts "Min"))
     (SETQ dimopts "PIpe")
    )
    ((EQ txtopts "Fixed")
     (SETQ dimopts "Fixed")
    )
  ) ;_ end of COND
  (IF (OR (EQ txtopts "Tce")
          (EQ txtopts "PIpe")
          (EQ txtopts "Min")
          (EQ txtopts "Fixed")
      ) ;_ end of OR
    NIL
    (PROGN
      (IF (EQ txtopts "PE")
        (PROGN
          (COMMAND ".UCS"
                   "V"
          ) ;_ end of COMMAND
          (C:ENGRLDRS)
        ) ;_ end of PROGN
      ) ;_ end of IF
      (SETVAR "osmode" 512)
      (IF upoint
        NIL
        (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of IF
      (SETQ
        rwdimpt_1 (upoint 1
                          ""
                          (STRCAT "First " dimopts " Dimension Point")
                          nil
                          nil
                  ) ;_ end of upoint
      ) ;_ end of SETQ
      (SETQ rwdimpt_1 (LIST (CAR rwdimpt_1) (CADR rwdimpt_1) 0.0))
      (SETVAR "osmode" 128)
      (SETQ
        rwdimpt_2
         (upoint 1
                 ""
                 (STRCAT "Second " dimopts " Dimension Point")
                 nil
                 rwdimpt_1
         ) ;_ end of upoint
      ) ;_ end of SETQ
      (SETQ rwdimpt_2 (LIST (CAR rwdimpt_2) (CADR rwdimpt_2) 0.0))
      (SETQ rwdimpt_3 (POLAR rwdimpt_1
                             (ANGLE rwdimpt_1 rwdimpt_2)
                             (/ (DISTANCE rwdimpt_1 rwdimpt_2) 2.0)
                      ) ;_ end of POLAR
      ) ;_ end of SETQ
      (SETVAR "osmode" 0)
;;;      (ALERT (IF stack_rwtxt "stack_rwtxt=T" "stack_rwtxt=NIL"))
      (COMMAND ".DIM"
               "ALI"
               rwdimpt_1
               rwdimpt_2
               rwdimpt_3
               (STRCAT ;(IF (EQUAL (DISTANCE rwdimpt_1 rwdimpt_2) 100.0 3.0)
                       ;  "100"
                         (RTOS (DISTANCE rwdimpt_1 rwdimpt_2) 2 dimucs_prec)
                       ;)
                       "' "
                       (IF (EQ txtopts "PE")
                         (STRCAT (IF ease_type ease_type "UTILITY") "\nEASEMENT")
                         (IF stack_rwtxt
                           "\\PR/W"
                           "R/W"
                         )
                       ) ;_ end of IF
               ) ;_ end of STRCAT
      ) ;_ end of COMMAND
      (COMMAND nil nil)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (C:ENGRLDRS)
  (IF (OR ;(EQ txtopts "PE")
          (EQ txtopts "Tce")
;          (EQ txtopts "PIpe")
          (EQ txtopts "Min")
          (EQ txtopts "Fixed")
      ) ;_ end of OR
    (PROGN
      (COMMAND ".UCS"
               "V"
      ) ;_ end of COMMAND
      (IF (OR (EQ txtopts "PIpe")(EQ txtopts "Min")(EQ txtopts "Fixed"))
        (SETVAR "osmode" 512)
        (IF (EQ txtopts "PE")
          (SETVAR "osmode" 1536)
          (SETVAR "osmode" 172)
        )
      ) ;_ end of IF
      (IF upoint
        NIL
        (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of IF
      (IF (EQ txtopts "Tce")
        (SETQ dimopts "TEMPORARY EASEMENT")
      )
      (SETQ rwdimpt_1
             (upoint
               1
               ""
               (STRCAT "First " dimopts " Dimension Point")
               nil
               nil
             ) ;_ end of upoint
      ) ;_ end of SETQ
      (SETQ rwdimpt_1 (LIST (CAR rwdimpt_1) (CADR rwdimpt_1) 0.0))
      (SETVAR "osmode" 172)
      (SETQ rwdimpt_2
             (upoint
               1
               ""
               (STRCAT "Second " dimopts " Dimension Point")
               nil
               rwdimpt_1
             ) ;_ end of upoint
      ) ;_ end of SETQ
      (SETQ rwdimpt_2 (LIST (CAR rwdimpt_2) (CADR rwdimpt_2) 0.0))
      (SETQ rwdimpt_3 (POLAR rwdimpt_1
                             (ANGLE rwdimpt_1 rwdimpt_2)
                             (/ (DISTANCE rwdimpt_1 rwdimpt_2) 2.0)
                      ) ;_ end of POLAR
      ) ;_ end of SETQ
      (SETVAR "osmode" 0)
      (COMMAND ".DIM"
               "ALI"
               rwdimpt_1
               rwdimpt_2
               rwdimpt_3
               (IF
                 (EQ txtopts "Fixed")
                  (IF (AND fixedtxt (/= fixedtxt ""))
                    fixedtxt
                    "10' MIN.\PSEP."
                  ) ;_ end of IF
                  (STRCAT
;;;                    (IF (EQ (REM (ATOF (RTOS (DISTANCE rwdimpt_1 rwdimpt_2) 2 1)) 0.5) 0.0)
;;;                      (RTOS (DISTANCE rwdimpt_1 rwdimpt_2) 2 1)
                      (RTOS (DISTANCE rwdimpt_1 rwdimpt_2) 2 dimucs_prec)
;;;                    ) ;_ end of IF
;                    (RTOS (DISTANCE rwdimpt_1 rwdimpt_2) 2 0)
                    (IF (EQ txtopts "PIpe")
                      "'"
                      (IF (EQ txtopts "Min")
                        "' MIN."
                        "' TEMPORARY\nCONSTRUCTION\nEASEMENT"
                      )
                    ) ;_ end of IF
                  ) ;_ end of STRCAT
               ) ;_ end of IF
      ) ;_ end of COMMAND
      (COMMAND nil nil)
      (COMMAND ".UCS" "W")
      (C:TSNAP)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (IF (OR (EQ txtopts "Tce")
;          (EQ txtopts "PIpe")
          (EQ txtopts "Min")
          (EQ txtopts "Fixed")
          (EQ txtopts "PE")
      ) ;_ end of OR
    NIL
    (PROGN
      (COMMAND ".UCS" "W")
      (C:TSNAP)
      (IF ureal
        NIL
        (LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
      ) ;_ end of IF
      (SETVAR "osmode" 512)
      (IF upoint
        NIL
        (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of IF
      (SETQ podimpt_1 (upoint
                        1                       ""
                        "First Pipe Offset Dimension Point"
                        nil                     nil
                       ) ;_ end of upoint
      ) ;_ end of SETQ
      (COMMAND ".UCS"
               "V"
      ) ;_ end of COMMAND
      (SETQ
        podimpt_1 (TRANS (LIST (CAR podimpt_1) (CADR podimpt_1) 0.0)
                         0
                         1
                  ) ;_ end of TRANS
      ) ;_ end of SETQ
      (SETVAR "osmode" 128)
      (SETQ podimpt_2 (upoint
                        1
                        ""
                        "Second Pipe Offset Dimension Point"
                        nil
                        podimpt_1
                       ) ;_ end of upoint
      ) ;_ end of SETQ
      (SETQ podimpt_2 (LIST (CAR podimpt_2) (CADR podimpt_2) 0.0))
      (SETQ podimpt_3 (POLAR podimpt_1
                             (ANGLE podimpt_1 podimpt_2)
                             (/ (DISTANCE podimpt_1 podimpt_2) 2.0)
                      ) ;_ end of POLAR
      ) ;_ end of SETQ
      (SETQ pipe_offset (DISTANCE podimpt_1 podimpt_2))
;;;      (IF (EQ (REM (ATOF (RTOS pipe_offset 2 1)) 0.5) 0.0)
;;;        (SETQ offset_str (RTOS pipe_offset 2 1))
        (SETQ offset_str (RTOS pipe_offset 2 dimucs_prec))
      (IF (> dimucs_prec 0)
        (PROGN
          (SETQ dimucs_prec_list (DOS_STRTOKENS offset_str "."))
          (IF
            (EQ (LENGTH dimucs_prec_list) 1); The effective precision was 0
            (SETQ offset_str
              (STRCAT offset_str
                (COND
                  ((EQ dimucs_prec 1)
                    ".0")
                  ((EQ dimucs_prec 2)
                    ".00")
                  ((EQ dimucs_prec 3)
                    ".000")
                  ((EQ dimucs_prec 4)
                    ".0000")
                  ((EQ dimucs_prec 5)
                    ".00000")
                )
              )
           )
           (PROGN
             (IF (/= (STRLEN (CADR dimucs_prec_list)) dimucs_prec)
               (STRCAT offset_str
               (COND
                 ((EQ dimucs_prec 2) ; the length of the 2nd string in the list MUST be 1 in this case
                  "0")
                 ((EQ dimucs_prec 3)
                  (COND
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 1)
                     "00")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 2)
                     "0")
                  ))
                 ((EQ dimucs_prec 4)
                  (COND
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 1)
                     "000")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 2)
                     "00")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 3)
                     "0")
                  ))
                 ((EQ dimucs_prec 5)
                  (COND
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 1)
                     "0000")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 2)
                     "000")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 3)
                     "00")
                    ((EQ (STRLEN (CADR dimucs_prec_list)) 4)
                     "0")
                  ))
               )
               )
             )
           )
          )
        )
      )
;;;      ) ;_ end of IF
      (SETVAR "osmode" 0)
      (COMMAND
        ".DIM"
        "ALI"
        podimpt_1
        podimpt_2
        podimpt_3
        (STRCAT offset_str
                "'"
                (IF (AND
                      (WCMATCH txtopts "Row+p,STacked-row+p")
                      (NOT (WCMATCH (GETVAR "dwgprefix") "*HA9701*"))
                    ) ;_ end of AND
                  " MIN."
                  ""
                ) ;_ end of IF
        ) ;_ end of STRCAT
      ) ;_ end of COMMAND
      (COMMAND nil nil)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (COMMAND ".UCS" "W")
  (C:TSNAP)
  (c:rslayr)
  (IF old_dimucsosmode
    (SETVAR "OSMODE" old_dimucsosmode)
  ) ;_ end of IF
  (IF old_dimucscmdecho
    (SETVAR "CMDECHO" old_dimucscmdecho)
  ) ;_ end of IF
  (IF orig_dimucs_error
    (SETQ *error* orig_dimucs_error)
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

[ODO18]

Just getting back to this.  Taking your recommendation I could not get it to work but I think I have something close to the direction you were thinking but still not working.  Any thoughts?

(defun c:ALeader ( / *error* mldr)

(command "-layer" "t" "E-S-T-DIM"
"on" "E-S-T-DIM" "")

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(if mst (setvar 'cmleaderstyle mst))
(if cec (setvar 'cecolor cec))
(if cel (setvar 'celtype cel))
(if cly (setvar 'clayer cly))
(if osm (setvar 'osmode osm))
(princ))

(setq mst (getvar 'cmleaderstyle)
cec (getvar 'cecolor)
cel (getvar 'celtype)
cly (getvar 'clayer)
osm (getvar 'osmode))
(if (setq e (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))
(progn (setq o (vlax-ename->vla-object
(cdr (assoc -1 (dictsearch (cdr (assoc -1 e)) (getvar 'cmleaderstyle))))
)
)
(VLA-PUT-MAXLEADERSEGMENTSPOINTS 0)
(VLA-PUT-ROTATION 0)
)
(
(if (tblsearch "layer" "E-S-T-NOTE")
(setvar "clayer" "E-S-T-NOTE")
(command "-layer" "M" "E-S-T-NOTE" "C" "white" "" "L" "Continuous" "" ""))
(setvar "cecolor" "bylayer")
(setvar "celtype" "bylayer")
(command "mleader")
(*error* "end")
)

[hencoop]

Both of these require an object to "PUT" the value to:

(VLA-PUT-MAXLEADERSEGMENTSPOINTS 0)
(VLA-PUT-ROTATION 0)

My acadauto.chm help file cannot be found!? ...so I cannot confirm the syntax for the function for you.

[ODO18]

Thanks for the help file reference.  Shortcut saved to my desktop now.

Sorry I am new to this VBA stuff.  It says VBA object is "object.MaxLeaderSegmentsPoints".  So do I just put that here?

 (VLA-PUT-MAXLEADERSEGMENTSPOINTS object.MaxLeaderSegmentsPoints 0).  There are no examples in the help.

The rotation one is less obvious but it looks like maybe this?  (VLA-PUT-ROTATION  textObj 0).  The reason why I say less obvious is I am not sure if that text objext can be part of an mleader or not as that is not how it is in the example.

[hencoop]

It's not VBA but is Visual Lisp.

The syntax is: (VLA-PUT-<property name> <object> <value>); or,

it can also be (VLAX-PUT-PROPERTY <object> '<property name> <value>)

[Anonymous]

I am also working on the same task using autocad your work is looking impressive but I think you need tolearn here about this task properly.

[ODO18]

I appreciate your help on this.  I believe your initial twist recommendation may be best, but it does not seem to work as you wrote it.  I have downloaded Visual Studio Code and been going through the VisualLisp codes and help files so I appreciate all that recommendation from everyone.  While I have been successful in changing all kinds of properties using the VLA-put commands I do not believe there is one that will make the mleader text rotate to horizontal regardless of the UCS.  I also cannot seem to be able to get the Lisp to make these settings temparary as it will permanently change the mleader style settings.  It is as if the error and end functions are not setting things back to the current 'cmleaderstyle.

Any additional guidance or help would be appreciated.  This is what I currently have:

(defun c:BLeader ( / *error* mst)

  (command "-layer" "t" "E-S-T-NOTE" 

                    "on" "E-S-T-NOTE" "")

  (defun *error* (errmsg)

    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end")

        )

      (princ (strcat "\nError: " errmsg))

    )

    (if mst (setvar 'cmleaderstyle mst))

    (if cec (setvar 'cecolor cec))

    (if cel (setvar 'celtype cel))

    (if cly (setvar 'clayer cly))

    (if osm (setvar 'osmode osm))

    (princ)

  )

  (setq mst (getvar 'cmleaderstyle)

        cec (getvar 'cecolor)

        cel (getvar 'celtype)

        cly (getvar 'clayer)

        osm (getvar 'osmode)

  )

  (if (setq e (dictsearch (namedobjdict) "ACAD_MLEADERSTYLE"))

   (progn (setq mymleaderstyle (vlax-ename->vla-object

       (cdr (assoc -1 (dictsearch (cdr (assoc -1 e)) (getvar 'cmleaderstyle))))

                  )

          )

      (VLA-PUT-MaxLeaderSegmentsPoints mymleaderstyle 0)

      (VLA-PUT-TextAngleType mymleaderstyle acHorizontalAngle)

   )

  )

  (if (tblsearch "layer" "E-S-T-NOTE")

    (setvar "clayer" "E-S-T-NOTE")

    (command "-layer" "M" "E-S-T-NOTE" "C" "white" "" "L" "Continuous" "" "")

  )

  (setvar "cecolor" "bylayer")

  (setvar "celtype" "bylayer")

  (command "mleader")

  (*error* "end")

)

[hencoop]

My technique for making Mleaders horizontal to the sheet in a twisted view is to temporarily set the UCS to "View" and then place the Mleader.  That sets the angle I need.  Then, I reset the UCS to what is was.

[ODO18]

ugh I know believe me I know.  Not difficult.  But the problem is getting the user to remember to switch ucs back to world after done.  So I figured if our dimension, mtext, and mleader commands could change the ucs for us then there is never a reason for the user to change their ucs.  I should explain this is for our survey department.  Survey has a profit margin of 0 because nobody values surveys unfortunatly, but our survey departments work like a machine very efficiently, so I thought it would be nice to provide them something that saves them a bunch of switching back and forth between UCS.

And to be fair I thought this was going to be easy.  I thought we could just take our dimension lisp (recently revamped) and do the same with mleader but it does not seem to be so easy.  This is what we have for dimension:

(defun c:ho ( / *error* dst)

(command "-layer" "t" "E-S-T-DIM"
"on" "E-S-T-DIM" "")

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(if dst (command-s "_.dimstyle" "_re" dst))
(if cec (setvar 'cecolor cec))
(if cel (setvar 'celtype cel))
(if cly (setvar 'clayer cly))
(if ddc (setvar 'dimdec ddc))
(if dtm (setvar 'dimtmove dtm))
(if osm (setvar 'osmode osm))
(command-s "_.ucs" "p")
(princ))

(setq dst (getvar 'dimstyle)
cec (getvar 'cecolor)
cel (getvar 'celtype)
cly (getvar 'clayer)
ddc (getvar 'dimdec)
dtm (getvar 'dimtmove)
osm (getvar 'osmode))
(if (tblsearch "dimstyle" "mydimstyle")
(command-s "_.dimstyle" "_re" "mydimstyle"))
(if (tblsearch "layer" "E-S-T-DIM")
(setvar "clayer" "E-S-T-DIM")
(command "-layer" "M" "E-S-T-DIM" "C" "white" "" "L" "Continuous" "" ""))
(setvar "cecolor" "bylayer")
(setvar "celtype" "bylayer")
(setvar "dimdec" 1)
(setvar "dimtmove" 2)
(command "ucs" "v")
(command "dimaligned")
(setvar "osmode" 1)
(command pause)
(setvar "osmode" 129)
(command pause)
(command "_non")
(command "@")
(*error* "end")
)

[hencoop]

I'm sorry I wasn't very clear.  All of the UCS manipulation is done within the program.  The user doesn't need to set it back.  I use this same method for dimensions.  The only difference with dimensions is that I set the UCS angle relative to the sheet so that the right-reading angle is controlled by dimension placement alone (we use about 107° from horizontal to the sheet).  The dimension will maintain the dimension text placement angles even if the UCS is subsequently changed which works out well for us.

[ODO18]

I am sorry.  Still not understanding.  How do you do the UCS manipulation within the program without using a LISP routine?

[hencoop]

Sorry, when I say "within the program" I am talking about within my lisp program.

[ODO18]

Ok then I do not know then.  Not sure why I cannot get it to work.  I just made the lisp routine run the mleader command and maxsegmentpoints of 0 and called it a day since our company style has a limit of 3 on the segment points.  They can just change their ucs when labeling with mleaders and mtext.

[hencoop · Accepted solution]

My approach is to get the text (contents for the mleader), its width (text wrapping), the point for the arrowhead and the landing point all before the actual Mleader placement.  Then, I set the UCS to "View", issue the Mleader command with the points (use TRANS to make sure they are in the coordinates I intend) and text in their appropriate place in the command input, and then finish up by setting the width using VLA-PUT-WIDTH (or whatever it actually is) and then resetting the UCS to what it was when I started.  (I have a dialog I created that lets me input the text and set the wrap width but that's not the only way for you to determine them.)

In summary, I get everything I need first and then I execute the Mleader command.  That makes it unnecessary to figure out how to PUT all the values I want into an already placed Mleader.  I create the Mleader with all of those values first (except width).  This allows me to set the UCS so that the angle is correct (0° in that UCS) and then set it back after placing the Mleader.

[ODO18]

Thank you.  That helped and lead me down some trails that have helped create the MTEXT lisp as well and understand more.

However, this works well if I take out the "maxsegmentpoints" option change and leave it as 3.  How would you make "pt2" continue unlimited until the user triggers "pt3" somehow?  I tried using the "while" in setq but that did not seem to help:

        (while (setq pt2 (getpoint "\nSpecify a point :"))

          (setq pts (cons pt pts))

        )

This is the entire lisp below which works if I take out  "o" "m" "0" "x" after _Mleader:

(defun c:AML ( / *error* mst)

  (defun *error* (errmsg)

    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end")

        )

      (princ (strcat "\nError: " errmsg))

    )

    (if mst (setvar 'cmleaderstyle mst))

    (if cec (setvar 'cecolor cec))

    (if cel (setvar 'celtype cel))

    (if cly (setvar 'clayer cly))

    (if osm (setvar 'osmode osm))

    (command-s "_.ucs" "_restore" "TempUCS")

    (command-s "_.ucs" "_delete" "TempUCS")

    (if cmd (setvar 'cmdecho cmd))

    (princ)

  )

  (setq mst (getvar 'cmleaderstyle)

        cec (getvar 'cecolor)

        cel (getvar 'celtype)

        cly (getvar 'clayer)

        osm (getvar 'osmode)

        cmd (getvar 'cmdecho)

  )

  (setvar "cmdecho" 0)

  (command "_.ucs" "_save" "TempUCS")

  (command "-layer" "t" "E-S-T-NOTE" 

                    "on" "E-S-T-NOTE" "") 

  (if (tblsearch "layer" "E-S-T-NOTE")

    (setvar "clayer" "E-S-T-NOTE")

    (command "-layer" "M" "E-S-T-NOTE" "C" "white" "" "L" "Continuous" "" "")

  )

  (setvar "cecolor" "bylayer")

  (setvar "celtype" "bylayer")

  (setvar "osmode" 0)

  (command ".UCS" "v")

  (setq pt1 (getpoint "Select arrowhead location: \n")

        pt2 (getpoint "Specify Next Point: \n")

        pt3 (getpoint "Select landing location: \n")

        txt (getstring T "Enter text (Hit Enter to End): ")

  )

  (command "_MLEADER" "o" "m" "0" "x"

           pt1

           pt2

           pt3

           txt

  )

  (*error* "end")

)

Also one concern I have with this method is that the user cannot see the line as they are placing the multiple pt2 or any of it.  Is there a way to make the line visible?  I am assuming not since it is setting the parameters first then running the command.

Thank you so much

[hencoop]

I’m away from my PC.  I would add the points from your pt2 while loop to a point list which has the leader location (pt1) as its first point.  You’ll need to initialize GETPOINT allowing NIL input so that the NIL input stops the loop.

Then, break/stop your 1st (COMMAND "multileader" …)  before points are to be input.  Use (FOREACH i <point list> (COMMAND i)) as your second (COMMAND ...) to input the point list.

Finally, finish up the multileader with whatever input is required in the 3rd (COMMAND …) function.

You can give the impression of placing the points interactively by putting (GRDRAW …) in your WHILE loop; however any zoom will clear those.  You can draw lines instead but you’ll need to add their enames to a selection set so you can delete them when you are done.

I typically do trial and error on what the (COMMAND…) function content needs to be in the separate parts.  It works best for me to construct a working single function (all-in-one) and then split it as indicated.

Summary: Collect all the data first, draw the psuedo mleader (lines) at the same time points are being collected and store their enames in a selection set for deletion later (each LINE ename is gotten with (ENTLAST) and added to your selection with (SSADD...)).  Place the Mleader with three separate functions.  The 1st starts the Mleader command and takes it up to just before the leader location is needed.  The points are entered by the 2nd function, i.e., (FOREACH i <point list> (COMMAND i)).  The 3rd function finishes the remainder of the Mleader command.

[hencoop]

P.S. When I construct my trial-and-error all-in-one command function I avoid lists and complications like that.  I'll put in specific points/symbols just to check that it completes without error.  Then, I split it into the multiple (COMMAND  ...) function calls I need.  Then I am ready to add the (FOREACH i <point list> (COMMAND i)) in place of (COMMAND pt1 pt2).

[hencoop]

PPS

I use this code (UPOINT.LSP) to make it easier to invoke the GETPOINT function.

It's usage is (upoint bit keyword message default basepoint) which returns a point or a keyword (if bit=1); e.g.,

(setq pt1 (upoint 1 "Quit" "Pick a point or [Quit]" nil <previous point>))

I commented out the two lines that load and run my chkkwds function.  It is only necessary if you programmatically construct your keyword string in real time which could contain invalid characters in the keywords.

;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 published by New Riders Publications, Copyright 1988, 1989.  This credit must accompany all copies of this function.

;;;October 19, 2004 added function to check keywords

;* UPOINT User interface point function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default point variable
;* is added as <DEF> (nil for none), and a : is added. BPT is base point
;* (nil for none).
;*
(defun upoint (bit kwd msg def bpt / inp)
;;;  (IF chkkwds nil (load "chkkwds" "\nFile CHKKWDS.LSP not loaded! "))
;;;  (chkkwds kwd)
  (if def
    (if (eq (type def) 'STR)
      (setq msg (strcat "\n" msg " <" def ">:")
            bit (* 2 (fix (/ bit 2)))
      )
      (progn
        (setq pts (strcat
                    (rtos (car def)) "," (rtos (cadr def))
                    (if
                      (and (caddr def) (= 0 (getvar "FLATLAND")))
                      (strcat "," (rtos (caddr def)))
                      ""
                  ) );if&strcat
              msg (strcat "\n" msg " <" pts ">: ")
              bit (* 2 (fix (/ bit 2)))
        )
      )
    )
    (setq msg (strcat "\n" msg ": "))
  );if a default was supplied
  (initget bit kwd)
  (setq inp
    (if bpt
       (getpoint msg bpt)
       (getpoint msg)
  ) );setq&if
  (if inp inp def)
);defun
;*
(princ)
;*