For your use: routine to create a dimension leader (ARC) to dimtext

[Anonymous]

I don't like the linear leader built into the dimension style. Everyone I
know tends to use arcs; I wish Autodesk would create this option in the
dimstyle.

This is a quick way to relocate the dimension text and automatically add a
leader to the dimtext. Erases any previous arcs which touch the dimline on
the current layer. Uses ADT's AECGENERATELAYERKEY "DIMLINE" to set the
layer if it can be found. Enjoy. All efforts have been made to credit the
original authors of portions of the code.


;;Place the following lines in your ACADDOC.LSP (S::STARTUP) routine
;;(autoload "DimensionArc" '("DimArc" "DA"))

(defun C:DA () (C:DIMARC) (princ))

(defun C:DIMARC (/ *ERROR* CMDECHO CLAY HLIT MUTTNO OMODE SS ENTDATA LL PT1
PT2 PT3 PTS-DIM
UR PTS-TEXT ANGLE1 ANGLE2)
;;; (load "DimensionCheckAccuracy.lsp")
;;; Application error handler thanks to Robert Bell
;;; revision 2006-03 March-30 by cpv
(defun *ERROR* (ERR)
(vla-endundomark
(vlax-get-property (vlax-get-acad-object) "ActiveDocument")) ; end
undo group
(cond ((not ERR)) ; no error, do nothing
((member (strcase ERR t) ; cancel, do undo
'("console break" "function cancelled" "quit / exit
abort"))
(command "._U"))
((member (strcase ERR t) ; cancel, do undo
'("function cancelled"))
(princ "\nExit"))
((princ (strcat "\nError: " ERR)))) ; unhandled error
(setvar "CmdEcho" CMDECHO)
(setq CMDECHO NIL)
(setvar "CLAYER" CLAY)
(setq CLAY NIL)
(setvar "HIGHLIGHT" HLIT)
(setq HLIT NIL)
(setvar "OSMODE" OMODE)
(setq OMODE NIL)
(setvar "NOMUTT" MUTTNO)
(setq MUTTNO NIL)
(princ)) ;_ closes defun *Error*
;;;
;;; Application code starts here
(vla-endundomark
(vlax-get-property (vlax-get-acad-object) "ActiveDocument"))
(vla-startundomark
(vlax-get-property (vlax-get-acad-object) "ActiveDocument"))
(setq CMDECHO (getvar "CmdEcho"))
(setq OMODE (getvar "osmode"))
(setq CLAY (getvar "CLAYER"))
(setq HLIT (getvar "HIGHLIGHT"))
(setq MUTTNO (getvar "NOMUTT"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(if (equal (getvar "pickfirst") 1)
(setq SS (cadr (ssgetfirst))))
(sssetfirst NIL NIL)
(setvar "highlight" 1)
(princ "\nSelect dimension text to relocate ...")
;(if (and (or SS (setq SS (ssget "+.:E:S" '((0 . "DIMENSION"))))))
(if (and
(or SS (setq SS (CADDXI-SSGET-PROMPT "" "+.:E:S" '((0 .
"DIMENSION"))))))
(progn ;(command "_.SELECT" SS "")
(setq SS (ssget "_P"))
(sssetfirst NIL SS) ;(if (null aecgeneratelayerkey)
(LAYERGENERATE "DIMLINE")
(command
"_aidimtextmove"
"2"
SS
""
""
(while (= (logand 1 (getvar "cmdactive")) 1) (command PAUSE)))
;(setvar "cmdecho" 0)
(setq PTS-DIM (GETDIMLINEPOINTS (setq ENTDATA (entget (ssname SS 0))))
LL (trans (car PTS-DIM) 0 1)
UR (trans (cadr PTS-DIM) 0 1)
ANGLE1 (angle UR LL))
(setq PT1 (polar LL (angle LL UR) (/ (distance LL UR) 2)))
(setq PTS-TEXT (GETDIMENSIONTEXTPOINT ENTDATA))
(if (< (distance (car PTS-TEXT) PT1) (distance (cadr PTS-TEXT) PT1))
(setq PT3 (car PTS-TEXT))
(setq PT3 (cadr PTS-TEXT)))
(setq ANGLE2 (angle PT1 PT3)
ANGLE3 (- ANGLE2 ANGLE1))
(cond ((or (and (> ANGLE3 0) (< ANGLE3 (* pi 0.5)))
;; 0 thru 90
(and (> ANGLE3 (* pi -1.0)) (< ANGLE3 (* pi -0.5)))
;; -90 thru -180
(and (> ANGLE3 (* pi -2.0)) (< ANGLE3 (* pi -1.5)))
;;-270 thru -360
(and (> ANGLE3 pi) (< ANGLE3 (* pi 1.5))))
;; 180 thru 270
;(princ (strcat "\nCond 1: " (rtos (RTOA ANGLE3) 2 2)))
(setq PT2 (polar (polar PT1 ANGLE2 (/ (distance PT1 PT3) 1.5))
(+ ANGLE2 0.5)
(/ (distance PT1 PT3) 4))))
((or (and (> ANGLE3 (* pi 0.5)) (< ANGLE3 pi))
;; 90 thru 180
(and (> ANGLE3 (* pi 1.5)) (< ANGLE3 (* pi 2)))
;; 270 thru 360
(and (> ANGLE3 (* pi -1.5)) (< ANGLE3 (* pi -1.0)))
;;-180 thru -270
(and (> ANGLE3 (* pi -0.5)) (< ANGLE3 0)))
;; 0 thru -90
;(princ (strcat "\nCond 2: " (rtos (RTOA ANGLE3) 2 2)))
(setq PT2 (polar (polar PT1 ANGLE2 (/ (distance PT1 PT3) 1.5))
(- ANGLE2 0.5)
(/ (distance PT1 PT3) 4))))
(t ;(princ (strcat "\nCond 3: " (rtos (RTOA ANGLE3) 2 2)))
(setq PT2 (polar PT1 (+ ANGLE2 0.1) (/ (distance PT1 PT3)
1.5)))))
(if (setq SS2 (ssget "_F"
(list (3DPOINT->2DPOINT LL) (3DPOINT->2DPOINT
UR))
(list (cons 0 "ARC") (cons 8 (getvar
"CLAYER")))))
(command ".ERASE" SS2 ""))
(command "_.ARC" PT1 PT2 PT3)
) ;(while (= (logand 1 (getvar "cmdactive")) 1) (command PAUSE))))
(princ "\nNothing selected."))
(*ERROR* NIL)
(princ))

(defun 3DPOINT->2DPOINT (3DPT)
(list (float (car 3DPT)) (float (cadr 3DPT))))

(defun RTOA (R) (/ (* R 180.0) pi)) ;Radian To Angle

(defun GETDIMENSIONTEXTPOINT (ENTDATA / OBJ ENAME ROT LL UR MP0 ML1 ML2)
(setq ENAME (car (GETDIMTEXTENAME ENTDATA)))
(setq OBJ (vlax-ename->vla-object ENAME))
(vla-getboundingbox OBJ 'LLC 'URC)
(setq ROT (vla-get-rotation OBJ))
(setq LL (trans (vlax-safearray->list LLC) 0 1))
(setq UR (trans (vlax-safearray->list URC) 0 1))
(setq MP0 (polar LL (angle LL UR) (/ (distance LL UR) 2)))
(setq ML1 (polar MP0
ROT
(+ (* (getvar "DIMGAP") (getvar "DIMSCALE")) (/ (distance
LL UR) 2))))
(setq ML2 (polar MP0
(+ ROT pi)
(+ (* (getvar "DIMGAP") (getvar "DIMSCALE")) (/ (distance
LL UR) 2))))
;(command
; "line" LL UR MP0 ML1 ML2
;(trans LL 0 1)
;(trans UR 0 1)
;(trans MP0 0 1)
;(trans ML1 0 1)
;(trans ML2 0 1)
; "")
(list ML1 ML2))

(defun GETDIMTEXTENAME (ENTDATA / RESULT ITEM)
(setq ENAME (tblobjname "block" (cdr (assoc 2 ENTDATA))))
(foreach
ITEM (NENTS ENAME "mtext")
(setq RESULT (append RESULT (list ITEM))))
RESULT)

(defun GETDIMLINEPOINTS (ELIST / DIM_NODE1 DIM_NODE2 DIM_NODES1 DIM_NODES2)
(setq DIM_NODES1 (cdr (assoc 13 ELIST))
DIM_NODES2 (cdr (assoc 14 ELIST))
DIM_NODE1 (cdr (assoc 10 ELIST))
DIM_ANGLE (cdr (assoc 50 ELIST))
DIM_NODE2 (cond
((or (= (cdr (assoc 70 ELIST)) 33) (= (cdr (assoc 70
ELIST)) 161))
(inters DIM_NODE1
(polar DIM_NODE1 (angle DIM_NODES2 DIM_NODES1)
1.0)
DIM_NODES1
(polar DIM_NODES1 (+ (angle DIM_NODES1
DIM_NODES2) (* 0.5 pi)) 1.0)
NIL))
(t
(inters DIM_NODE1
(polar DIM_NODE1 DIM_ANGLE 1.0)
DIM_NODES1
(polar DIM_NODES1 (+ DIM_ANGLE (* 0.5 pi))
1.0)
NIL))))
(list DIM_NODE1 DIM_NODE2))


; Jason Piercey
; obtain the entity name(s) of the subentities that match [filter]
; [ename] - entity name of a block, attributed insert, or polyline
; [filter] - string, re: (wcmatch)
; return: list of entity names or nil
(defun NENTS (ENAME FILTER / DATA RTN)
(setq FILTER (strcase FILTER))
(while (and ENAME (setq ENAME (entnext ENAME)))
(setq DATA (cdr (assoc 0 (entget ENAME))))
(if (wcmatch DATA FILTER)
(setq RTN (cons ENAME RTN)))
(if (= "SEQEND" DATA)
(setq ENAME NIL)))
(reverse RTN))

;; John Uhden
(defun WCSANG (ANG)
(angle (trans '(0 0 0) 1 0) (trans (polar '(0 0 0) ANG 1e6) 1 0)))

;; Luis Esquivel
;; (setq ss (caddxi-ssget-prompt "Select my entities: " nil))
;; (setq ss (caddxi-ssget-prompt "Select my entities: " '((0 . "ARC"))))
;; (setq ss (caddxi-ssget-prompt nil nil))
(defun CADDXI-SSGET-PROMPT (MSG METHOD FILTER / SS *CURRENT-NOMUTT*)
(setq *CURRENT-NOMUTT* (getvar "nomutt"))
(prompt (strcat "\n"
(cond (MSG)
("Select objects: "))))
(setvar "NOMUTT" 1)
(setq SS (vl-catch-all-apply 'ssget (list METHOD FILTER))) 😉
(setvar "NOMUTT" *CURRENT-NOMUTT*)
SS)



(defun LAYERGENERATE (LAYERKEY / LAY)
(if (null AECGENERATELAYERKEY)
(JB:LOADAECLAYERARX))
(setq LAY (AECGENERATELAYERKEY LAYERKEY))
(if LAY
(setvar "clayer" LAY)))

;James Buzbee
(defun JB:LOADAECLAYERARX (/)
(if (null AECSETLAYERKEYOVERRIDE)
(progn
(cond ((= (substr (getvar "ACADVER") 1 5) "15.06")
(setq FILE (strcat (vla-get-path (vlax-get-acad-object))
"\\AecLayerManagerUI30.arx")))
((= (substr (getvar "ACADVER") 1 4) "16.0")
(setq FILE (strcat (vla-get-path (vlax-get-acad-object))
"\\AecLMgrLisp40.arx")))
((= (substr (getvar "ACADVER") 1 4) "16.1")
(setq FILE (strcat (vla-get-path (vlax-get-acad-object))
"\\AecLMgrLisp45.arx")))
((= (substr (getvar "ACADVER") 1 4) "16.2")
(setq FILE (strcat (vla-get-path (vlax-get-acad-object))
"\\AecLMgrLisp47.arx"))))
; (arxload file []))))
(arxload FILE))))

;|«Visual LISP© Format Options»
(94 2 4 0 nil "end of " 72 6 1 2 1 nil nil nil T)
;*** DO NOT add text below the comment! ***|;