Leader Spline Lisp Fix/Addition

JohnC_ISM · ‎08-23-2019

we have a lisp called LDS that creates a splined line with arrow head for callouts.

is there a line someone could add in to make it automatically spline?

also, a bug i just noticed that if my midpoint selection is off then it snaps to the base corner instead of the midpoint of the arrow head. not a issue really but something i noticed.

(gc)
(COMMAND "COLOR" "BYLAYER")
(defun c:11(/ p1 p2 p3 p4)
(command "color" "CYAN")
(gc)
(setvar "cmdecho" 0)
(command "color" "CYAN")
(while (setq p1(getpoint "\nLeader start: "))
(initget 1)
(setq p2(getpoint p1 "\nNext point: "))
(if (> (distance p1 p2) (* (getvar "dimasz")(getvar "dimscale")))
(progn
(setq p3(polar p1 (angle p1 p2)
(* (getvar "dimasz")(getvar "dimscale")))
)
(setq p4(polar p3 (+ (angle p1 p2) (* 1.5 pi))
(/ (* (getvar "dimasz")(getvar "dimscale")) 6.0))
)
(command "solid" p4 (polar p4 (+ (angle p1 p2) (* 0.5 pi))
(/ (* (getvar "dimasz")(getvar "dimscale")) 3.0)) p1 p1 ""
)
(command "line" p3 p2 "")
)
(command "line" p1 p2 "")
)
(setq ss1(ssadd))
(setq ss1(entlast))
(setq p1 p2)
(setq ss(ssadd))
(prompt " add ok")
(while (setq p2(getpoint p1 "\nNext point: "))
(command "line" p1 p2 "")
(setq tmp(entlast))
(ssadd tmp ss)
(setq p1 p2)
)
(command "pedit" ss1 "y" "j" ss "" "s" "")
)
(gc)
(princ)
(gc)
(COMMAND "COLOR" "BYLAYER")
(setq ss1 nil ss nil)
(princ "done.")
(princ)
)
;;
;;
;; *********** Local Error Trap Function ************
;;
(defun myerror (sxx)
(if (= sxx nil)
(setq sxx "console break")
); end if
(if (not (member sxx '("console break" "Function cancelled")))
(princ (strcat "\nError: " sxx))
); end if
(if (= (member sxx '("console break" "Function cancelled")))
(progn
(prompt "\nError: Break...")
(setvar "MENUECHO" 0)
(setvar "HIGHLIGHT" 1)
(setvar "SORTENTS" 1)
(setvar "ATTDIA" 0); No Attribute Dialog Boxes, please
(setvar "ATTREQ" 1); Attributes Required
(setvar "CMDDIA" 1); Plot command dialog on
); end progn
); end if
(setvars); reset all old system variables
(setvar "CMDECHO" 0)
(setq sxx nil)
(princ)
); end function err
(setq olderr *error* *error* myerror)
;;
;; Get Old System Variables
;;
(defun getvars ()
(setq osm (getvar "OSMODE"))
;; add any other system variables here
); end function
(defun setvars ()
(setvar "OSMODE" osm)
;; reset any other system variables here
); end function
;; *************** end of error trapping *****************
;;

ronjonp · ‎08-28-2019

@dlanorh wrote:
@Kent1Cooper wrote:
@JohnC_ISM wrote:
.... the qleader style resets each drawing i jump into.
anyway to make the settings permanent no matter whose drawing i open?

I'd like that, too. It's been a while since I tried to figure that out, but I wasn't able to -- it's not saved in something as easy as System Variables. Maybe the Registry?

(setq x_rec (dictsearch (namedobjdict) "AcadDim"))

This does not return anything in AutoCAD 2020.

dlanorh · ‎08-28-2019

I don't think it is set until QLeader is used for the first time.

These are Frank Whaley's lisps. I'm not sure if they are the originals or have been "tweaked" as I can't access my work computer. Although they are prefixed with (acet) they are not part of Express Tools.

(defun acet-ql-get (/ xr cod itm reply);;get settings
  (if (setq xr (dictsearch (namedobjdict) "AcadDim"))
    (progn
      (foreach cod '(3 40 60 61 62 63 64 65 66 67 68 69 70 71 72 170 340)
        (if (setq itm (assoc cod xr))(setq reply (append reply (list itm))))
      )
      reply
    )
    (setq reply '( (3 . "") (40 . 0.0) (60 . 0) (61 . 1) (62 . 1) (63 . 3) (64 . 0) (65 . 0) (66 . 0) (67 . 3)
                   (68 . 1) (69 . 0) (70 . 0) (71 . 0) (72 . 0) (170 . 0));default settings
    )
  )
)

(defun acet-ql-set (arg / cur prm);;set settings
  (setq cur (acet-ql-get))
  (while arg
    (setq prm (car arg)
          arg (cdr arg)
          cur (subst prm (assoc (car prm) cur) cur)
    )
    ;; handle DIMLDRBLK
    (if (= 3 (car prm)) (setvar "DIMLDRBLK" (cdr prm)))
  )
  ;; put back
  (dictremove (namedobjdict) "AcadDim")
  (setq cur (append '((0 . "XRECORD") (100 . "AcDbXrecord") (90 . 990106)) cur))
  (dictadd (namedobjdict) "AcadDim" (entmakex cur))
)

'((60 . 4)(65 . 1)(66 . 1)(170 . 1));sets the qleader settings ((No annotation)(splined leader line)(No point limit)(Leader Line & Arrow))

IIRC Doing a set initializes without having to run QLEADER on the command line

(setq qls (acet-ql-get)) ;return current settings or default list

(acet-ql-set '((60 . 4)(65 . 1)(66 . 1)(170 . 1)));;set the settings you want

(acet-ql-set c_qls);;to reset on exit

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/qleader-settings/m-p/2273593#M262000

Link above is to one of several archived pages that gives a full list of the dotted pairs and what settings they change.

I remember having problems setting sysvar "DIMLDRBLK", but i'm sure "" or "." works in a (setvar) but not on the command line when you have to enter a . for the default "closed filled".

I am not one of the robots you're looking for

john.uhden · ‎08-28-2019

I am pretty sure that you will have to build a function to create the
DIMSTYLE you want. I did it back in the old days with nothing but DXF
codes that I had to figure out. It's probably easier these days with
ActiveX properties.
I should be able to extract the code if you want. Just not right now as I
am using my wife's laptop. BTW, "extract" is not the word I was looking
for. Maybe Al Zheimer has hidden it from me.

John F. Uhden

Kent1Cooper · ‎08-29-2019

@dlanorh wrote:
(setq x_rec (dictsearch (namedobjdict) "AcadDim"))

@ronjonp wrote:
This does not return anything in AutoCAD 2020.

@dlanorh wrote:

I don't think it is set until QLeader is used for the first time.

[Nothing in Acad2019 either, even after using Qleader.]

Kent Cooper, AIA

dlanorh · ‎08-29-2019

I'm still using Acad2012 so cannot test on later versions

I am not one of the robots you're looking for

john.uhden · ‎08-29-2019

Here is an excerpt from my LABEL_IT program. It's not intended to be a solution, but just an indication of what's involved with dimension styles and leaders.

BTW, all those things beginning with a pipe character "|" are just my old style of symbol naming. The @ prefix is just my style of naming functions.

   (defun @update_dimstyle ( / |old |new)
      (@fun "@update_dimstyle")
      (setq |old (entget (tblobjname "dimstyle" "LABEL_IT")))
      (setq |new |old)
      (setq |new (@cv_subst (cons 77 0)(assoc 77 |new) |new))          ; force DIMTAD to 0
      (setq |new (@cv_subst (cons 3 |dimpost)(assoc 3 |new) |new))     ; DIMPOST
      (setq |new (@cv_subst (cons 4 |dimapost)(assoc 4 |new) |new))    ; DIMAPOST
      (setq |new (@cv_subst (cons 170 |dimalt)(assoc 170 |new) |new))  ; DIMALT
      (setq |new (@cv_subst (cons 143 |dimaltf)(assoc 143 |new) |new)) ; DIMALTF
      (setq |new (@cv_subst (cons 171 |dimaltd)(assoc 171 |new) |new)) ; DIMALTD
      ;; There's some freakin problem with (entmod)ing a dimstyle
      ;; with code 179 in it!?  If we chuck it, it works ok (04-07-00)...
      ;; same for 277 (11-29-00)
      (if (assoc 179 |new)
         (setq |new (vl-remove (assoc 179 |new) |new))                   ; DIMADEC
      )
      (if (assoc 277 |new)
         (setq |new (vl-remove (assoc 277 |new) |new))                   ; DIMLUNIT
      )
      ;; same for 279 (01-16-01) according to Chris at DPK
      (if (assoc 279 |new)
         (setq |new (vl-remove (assoc 279 |new) |new))                   ; DIMTMOVE
      )
      (if (not (equal |new |old))(entmod |new))
      (setq Funs (cdr Funs))
   )
   (defun @cv_dimstyle ( / -|de -|dent -|se -|dbe -|dbowner)
      (@fun "@cv_dimstyle")
      ;; globals: |lcolor
      (cond
         ((setq |dent (tblsearch "dimstyle" "LABEL_IT"))
            (setq |dimalt   (cdr (assoc 170 |dent))
                  |dimasz   (cdr (assoc 41 |dent))
                  |dimgap   (cdr (assoc 147 |dent))
                  |dimpost  (cdr (assoc 3 |dent))
                  |dimapost (cdr (assoc 4 |dent))
                  |dimaltf  (cdr (assoc 143 |dent))
                  |dimaltd  (cdr (assoc 171 |dent))
                  |dimsah   (cdr (assoc 173 |dent))
            )
            (@update_dimstyle)
         )
         ;; added 01-26-01 to use the R14 dimstyle and rename it
         ((setq |dent (tblsearch "dimstyle" "LABEL_IT$7"))
            (@command (list "RENAME" "_Dimstyle" "LABEL_IT$7" "LABEL_IT") 0)
            (setq |dimalt   (cdr (assoc 170 |dent))
                  |dimasz   (cdr (assoc 41 |dent))
                  |dimgap   (cdr (assoc 147 |dent))
                  |dimpost  (cdr (assoc 3 |dent))
                  |dimapost (cdr (assoc 4 |dent))
                  |dimaltf  (cdr (assoc 143 |dent))
                  |dimaltd  (cdr (assoc 171 |dent))
                  |dimsah   (cdr (assoc 173 |dent))
            )
            (@update_dimstyle)
         )
         (1 (setq |dimalt (getvar "dimalt"))
            ;;***********************************************************************
            ;; I'm guessing that R13 crapped out because it didn't have a "_DOTSMALL"
            ;; block definition built-in.  So here's the R14 version:
            ;;
            (if (not (tblsearch "block" "_dotsmall"))
               (progn
                  (entmake '((0 . "BLOCK")(2 . "_DOTSMALL")(70 . 0)(10 0.0 0.0 0.0)))
                  (entmake
                    '((0 . "POLYLINE")(67 . 0)(8 . "0")(62 . 0)(6 . "BYBLOCK")
                      (66 . 1)(10 0.0 0.0 0.0)(70 . 1)(40 . 0.5)(41 . 0.5)
                      (210 0.0 0.0 1.0)(71 . 0)(72 . 0)(73 . 0)(74 . 0)(75 . 0)
                     )
                  )
                  (entmake
                    '((0 . "VERTEX")(67 . 0)(8 . "0")(62 . 0)(6 . "BYBLOCK")(10 -0.0625 0.0 0.0)
                      (40 . 0.5)(41 . 0.5)(42 . 1.0)(70 . 0)(50 . 0.0)
                     )
                  )
                  (entmake
                    '((0 . "VERTEX")(67 . 0)(8 . "0")(62 . 0)(6 . "BYBLOCK")(10 0.0625 0.0 0.0)
                      (40 . 0.5)(41 . 0.5)(42 . 1.0)(70 . 0)(50 . 0.0)
                     )
                  )
                  (entmake '((0 . "SEQEND")(67 . 0)(8 . "0")(62 . 0)(6 . "BYBLOCK")))
                  (entmake '((0 . "ENDBLK")))
               )
            )
            (setq |dimblk "_DOTSMALL"
                  |dbe (tblobjname "block" |dimblk)
                  |dbowner (cdr (assoc 330 (entget |dbe)))
            )
            (@make_style "L80" "simplex" 0.08 1.0 0.0)
            (setq |se (tblobjname "style" "L80"))
            (entmake
               (list
                 '(0 . "DIMSTYLE")
                 '(100 . "AcDbSymbolTableRecord")
                 '(100 . "AcDbDimStyleTableRecord")
                 '(2 . "LABEL_IT")
                 '(70 . 0)           ; DIMASO
                  (cons 3 |dimpost)  ; DIMPOST
                  (cons 4 |dimapost) ; DIMAPOST
                  (cons 5 |dimblk)   ; DIMBLK
                  (cons 5 |dimblk)   ; DIMBLK1
                  (cons 5 |dimblk)   ; DIMBLK1
                  (cons 40 |scale)   ; DIMSCALE
                  (cons 41 |dimasz)  ; DIMASZ
                 '(42 . 0.05)        ; DIMEXO
                 '(43 . 0.38)        ; DIMDLI
                 '(44 . 0.1)         ; DIMEXE
                 '(45 . 0.0)         ; DIMRND
                 '(46 . 0.0)         ; DIMDLE
                 '(47 . 0.0)         ; DIMTP
                 '(48 . 0.0)         ; DIMTM
                 '(140 . 0.08)       ; DIMTXT
                 '(141 . 0.09)       ; DIMCEN
                 '(142 . 0.0)        ; DIMTSZ
                  (cons 143 |dimaltf); DIMALTF
                 '(144 . 1.0)        ; DIMLFAC
                 '(145 . 1.0)        ; DIMTVP
                 '(146 . 1.0)        ; DIMTFAC
                  (cons 147 |dimgap) ; DIMGAP
                 '(71 . 0)           ; DIMTOL
                 '(72 . 0)           ; DIMLIM
                 '(73 . 0)           ; DIMTIH
                 '(74 . 0)           ; DIMTOH
                 '(75 . 1)           ; DIMSE1
                 '(76 . 1)           ; DIMSE2
                 '(77 . 0)           ; DIMTAD  !! This controls the placement of the leader hook !!
                                     ; Controls the vertical position of text in relation to the
                                     ; dimension line.
                                     ; 0  Centers the dimension text between the extension lines.
                                     ; 1  Places the dimension text above the dimension line except
                                     ;    when the dimension line is not horizontal and text inside
                                     ;    the extension lines is forced horizontal (DIMTIH = 1).
                                     ;    The distance from the dimension line to the baseline of
                                     ;    the lowest line of text is the current DIMGAP value.
                                     ; 2  Places the dimension text on the side of the dimension
                                     ;    line farthest away from the defining points.
                                     ; 3  Places the dimension text to conform to Japanese
                                     ;    Industrial Standards (JIS).
                 '(78 . 1)           ; DIMZIN
                  (cons 170 |dimalt) ; DIMALT
                  (cons 171 |dimaltd); DIMALTD
                 '(172 . 0)          ; DIMTOFL
                  (cons 173 |dimsah) ; DIMSAH
                 '(174 . 0)          ; DIMTIX
                 '(175 . 0)          ; DIMSOXD
                 '(176 . 0)          ; DIMDLRD !! The on-line help is wrong !!
                                     ; There is no DIMDLRD !
                                     ; This is really where DIMCLRD is stored, being
                                     ; the leader color as an integer from 0 to 256
                 '(177 . 0)          ; DIMCLRE
                 '(178 . 0)          ; DIMCLRT
               ;   (cons 179 |auprec) ; DIMADEC (new in R15), but bombs (11-29-00)
               ;  '(270 . 2)          ; DIMUNIT ; (obsolete in R15, now use DIMLUNIT AND DIMFRAC)
                 '(271 . 2)          ; DIMDEC
                 '(272 . 2)          ; DIMTDEC
                 '(273 . 2)          ; DIMALTU
                 '(274 . 2)          ; DIMALTTD
                  (cons 340 |se)     ; Handle of referenced STYLE object
                                     ; (used instead of storing DIMTXSTY value)
                 '(275 . 1)          ; DIMAUNIT
               ;   (cons 277 |lunits) ; DIMLUNITS (new in R15), but bombs (11-29-00)
                 '(280 . 0)          ; DIMJUST
                 '(281 . 0)          ; DIMSD1
                 '(282 . 0)          ; DIMSD2
                 '(283 . 1)          ; DIMTOLJ
                 '(284 . 3)          ; DIMTZIN
                 '(285 . 3)          ; DIMALTZ
                 '(286 . 3)          ; DIMALTTZ
                 '(287 . 4)          ; DIMFIT
                 '(288 . 0)          ; DIMUPT
                  (cons 341 |dbowner); DIMLDRBLK (new in R15)
               )
            )
            (setq |de (tblobjname "dimstyle" "LABEL_IT"))
         )
      )
      (setq Funs (cdr Funs))
   )
   (defun @leader (|str |p1 |p2 / |p3 |p4 |ang |a |dirx |diry |mt |mtent |71 |74
                                  |format |i |e |ent |dsent |n |lent |slist)
      (@fun "@leader")
      ;;
      ;;        p2-----p3    p4 [MTEXT]
      ;;       /     \     \
      ;;      /       \     \
      ;;     /         \     (* |scale |dimgap)
      ;;    /           \
      ;;   p1            (* |scale |dimasz)

      (@cv_dimstyle) ;; sets up the dimstyle and/or gets |dimgap and |dimasz
      (setq |ucsang (rem (- 2pi (eval (cons 'atan (cdr (reverse (getvar "ucsxdir")))))) 2pi)
            |vtwist (rem (- 2pi (getvar "viewtwist")) 2pi)
            |0ang   (+ |ucsang |vtwist)
            |dsent  (tblsearch "dimstyle" "LABEL_IT")
            |dimasz (cdr (assoc 41 |dsent))
            |dimgap (cdr (assoc 147 |dsent))
            |dimsah (cdr (assoc 173 |dsent))
            |dimtad (cdr (assoc 77 |dsent))
            |ang (if (> |acadver 13) |0ang |vtwist)
            |format "\\A1;"
      )
      (if (and (= (logand $override 16) 16) ; width factor
               (/= &wf 1.0))
         (setq |format (strcat |format "\\W" (rtos &wf 2 10) ";"))
         (while (= (substr |format (setq |i (strlen |format))) "0")
            (setq |format (substr |format 1 (1- |i)))
         )
      )
      (if (and (= (logand $override 32) 32) ; obliquing angle
               (/= &obl 0.0))
         (setq |format (strcat |format "\\Q" (@angtos &obl 0 10) ";"))
         (while (= (substr |format (setq |i (strlen |format))) "0")
            (setq |format (substr |format 1 (1- |i)))
         )
      )
      (if (< (car (trans |p2 1 2))(car (trans |p1 1 2)))
         (setq |ang (+ |ang pi) |71 6 |74 1)
         (setq |71 4 |74 0)
      )
      ; Code 71 =
      ; Attachment point:
      ; 1 = Top left; 2 = Top center; 3 = Top right ;
      ; 4 = Middle left; 5 = Middle center; 6 = Middle right
      ; 7 = Bottom left; 8 = Bottom center; 9 = Bottom right
      (if (or (> |dimtad 0)(> |dimasz 0))
         (setq |p3 (polar |p2 |ang (* |scale |dimasz))
               |p4 (polar |p3 |ang (* |scale |dimgap))
               |n 3
         )
         (setq |p3 nil
               |p4 (polar |p2 |ang (* |scale (+ |dimgap |dimasz)))
               |n 2
         )
      )
      (setq |str (strcat |format |str)
            |slist (list (cons 1 (substr |str 1 255)))
            |str (substr |str 256)
      )
      (while (> (strlen |str) 0)
         (setq |slist (append |slist (list (cons 3 (substr |str 1 255))))
               |str (substr |str 256)
         )
      )
      (setq |mtent
         (append
            (list
              '(0 . "MTEXT")
               (if (> |acadver 13)'(102 . "{ACAD_REACTORS") nil)
               (if (> |acadver 13)(cons 330 (entlast)) nil)
               (if (> |acadver 13)'(102 . "}") nil)
              '(100 . "AcDbEntity")
               (cons 8 &layer)
              '(100 . "AcDbMText")
               (cons 10 (@2d (trans |p4 1 0)))
               (cons 40 &height)
              '(41 . 0.0)
               (cons 62 &tcolor)
               (cons 71 |71)
              '(72 . 1)
            )
            |slist
            (if (= &style "*Current*")
               (list
                  (cons 7 |textstyle)
                 '(210 0.0 0.0 1.0)
               )
               (list
                  (cons 7 &style)
                 '(210 0.0 0.0 1.0)
               )
            )
            (if (> |acadver 13)
               (list
                 '(11 1.0 0.0 0.0)
                  (cons 50 |0ang) ; This **** is w/r/t the Current UCS!
               )
               (list (list 11 (cos |vtwist)(sin |vtwist) 0.0))
            )
         )
      )
      (setq |mtent (vl-remove nil |mtent))
      (if (entmake |mtent)
         (setq |mt (entlast)
               |mtent (entget |mt '("*"))
               |mt (handent (cdr (assoc 5 |mtent)))
               ;; in R13 there are no 42 or 43 codes.
               ;; Looks like it was only half-built (that's R13)
               |mtw (if (> |acadver 13)(cdr (assoc 42 |mtent)) 0.1)
               |mth (if (> |acadver 13)(cdr (assoc 43 |mtent)) &height)
               |lent
            (list
              '(0 . "LEADER")
              '(100 . "AcDbEntity")
               (cons 8 &layer)
              '(100 . "AcDbLeader")
              '(3 . "LABEL_IT")
               (cons 62 |lcolor)
               (cons 71 1)       ; Arrowhead flag: 0 = disabled; 1 = enabled
               (cons 72 |lshape) ; 0 = straight, 1 = splined
              '(73 . 0)          ; created with text (actually MTEXT) annotation
               (cons 74 |74)     ; Hookline direction flag:
                                 ;   0 = hookline (or end of tangent for a splined leader)
                                 ;       is the opposite direction from the horizontal vector.
                                 ;   1 = hookline (or end of tangent for a splined leader)
                                 ;       is the same direction as horizontal vector (see code 75).
      ;        '(75 . 1)          ; Hookline flag: 0 = no hookline; 1 = has a hookline
               (if (> |n 2)(cons 75 1)(cons 75 0))
               (cons 40 |mth)
               (cons 41 |mtw)
               (cons 76 |n)          ; Number of vertices in leader (ignored for DXFIN)
               (cons 10 (@2d (trans |p1 1 0)))
               (cons 10 (@2d (trans |p2 1 0)))
               (if |p3 (cons 10 (@2d (trans |p3 1 0))) nil)
              '(77 . 256)        ; Color to use if leader's DIMCLRD=BYBLOCK
               (if (> |acadver 13)(cons 340 |mt) nil)
               (list 211 (cos |vtwist)(sin |vtwist) 0.0)
              '(210 0.0 0.0 1.0)
              '(212 0.0 0.0 0.0)
              '(213 0.0 0.0 0.0)
            )
            |lent (vl-remove nil |lent)
         )
         (prompt "\nUnable to create MTEXT")
      )
      (if (and |lent (entmake |lent))
         (progn
            (setq |e   (entlast)
                  |ent (entget |e)
                  |e (handent (cdr (assoc 5 |ent)))
            )
            (setq |mtent (@cv_subst (cons 330 |e)(assoc 330 |mtent) |mtent))
            (@entmod |mtent)
            ;; The following is based on ignorance, since I found out (9-28-99)
            ;; that the leader color is totally based on the "DIMCLRD" drawing variable
            ;; which is NOT saved with a dimstyle (at least in R14).
            ;; So all we have to do is set it to the value of |lcolor!
            ;; BBZZZZT... wrong again... entmaking a leader ignores both the 62 code
            ;; and the value of DIMCLRD.  Back to brute force:
            ;; BBZZZZZZZZTTT again!!  The DIMCLRD is stored in the leader child dimstyle
            ;; under code 176 (the on-line-help says it's DIMDLRD but there is no DIMDLRD).
            ;; So we'll try changing the DIMSTYLE object before creating the leader...
            ;;    See the @cv_dimstyle function.
            ;; Nope... tried it, but changing the dimstyle will change all the leaders
            ;; to the current label style's DIMCLRD value.  So back to brute force...
            (command "_.change" |e "" "_P" "_C" (@color$ |lcolor) "")
            (setq Funs (cdr Funs))
            |mt ; return the name of the MTEXT object
         )
         (progn
            (setq Funs (cdr Funs))
            (prompt "\nLeader creation failed.\n")
         )
      )
   )

John F. Uhden

Community

Leader Spline Lisp Fix/Addition

Leader Spline Lisp Fix/Addition

Leader Spline Lisp Fix/Addition