Sorry , My English is not good
As I do not yet know how to code properly in LISP
Can help me add text misplacement?
Same as the picture
thank very much!!!
(defun C:OrdinateDimAlign (/ OSPRE eDimBase ENTS Filter XorY XorY-Txt
;|Functions|; GetX GetY jlgg-SSToList GetDimOrdinateType AlignTextDims
)
;;-------------------------- jlgg-SSToList -------------------------------
;; selection set to list of entities
;;------------------------------------------------------------------------
(defun jlgg-SSToList (ss / ssl n)
(if (and ss (= (type ss) 'PICKSET))
(repeat (setq n (sslength ss))
(setq ssl (cons (ssname ss (setq n (1- n))) ssl))))
);c.defun
;;;_______________________________________________________________________________________________________
;; Returns "HOR" value of a point from an entities data record
(defun GetX (eDimBase ANUM) (cadr (assoc ANUM (entget eDimBase))))
;;;_______________________________________________________________________________________________________
;; Returns "VER" value of a point from an entities data record
(defun GetY (eDimBase ANUM) (caddr (assoc ANUM (entget eDimBase))))
;;;_______________________________________________________________________________________________________
;;; Determines if dims are horizontal or vertical
(defun GetDimOrdinateType (eDimBase / Code70)
(setq Code70 (cdr (assoc 70 (entget eDimBase))))
(if (= 64 (logand 64 Code70))
(setq XorY 64 XorY-Txt "Abscissa")
(setq XorY 0 XorY-Txt "Ordinate")
)
)
;;;_______________________________________________________________________________________________________
;;; Aligns dims
(defun AlignTextDims (LstCotas / )
(mapcar
(function
(lambda (eDim / NewPt EntLst)
(setq NewPt
(cond
((= XorY 0 ) (list 14 (GetX eDimBase 14) (GetY eDim 14) 0.0))
((= XorY 64) (list 14 (GetX eDim 14) (GetY eDimBase 14) 0.0))
)
)
;(princ "\nPT = ")(princ NewPt)
(setq EntLst (entget eDim)) ; Sets EntLst to data record of ENTA
;(princ "\nENTLST = ")(princ EntLst)
(setq EntLst (subst NewPt (assoc 14 (entget eDim)) EntLst)) ; Substitutes new point for DXF# 14
;(princ "\nENTLST = ")(princ EntLst)
(entmod EntLst) ; Submits list to modify entity name contained in the list
)
)
LstCotas
)
);defun
;;-------------------------- MAIN --------------------------
(command "CMDECHO" 0)
(setq OSPRE (getvar "OSMODE"))
(setq Filter (list '(0 . "DIMENSION")))
;;Imputs user:
(while (not eDimBase)
(prompt "\nSelect base Ordinate dimension to align to: ")
(cond
((and (setq eDimBase (ssget "_:S:E" Filter))
(setq eDimBase (ssname eDimBase 0))
(= 6 (logand 6 (cdr (assoc 70 (entget eDimBase))))) ;; = OrdinateDimension
;;(vl-some (function (lambda (x) (= (cdr x) "AcDbOrdinateDimension"))) (entget eDimBase)))
)
)
(T
(prompt "\nNot selected Ordinate dimension..")
(setq eDimBase nil)
)
)
)
;;; Determines if dims are horizontal or vertical:
(GetDimOrdinateType eDimBase)
;;_______________________________________________________
;; Selects dimensions to align to base
(while (not ENTS)
(prompt (strcat "\nSelect dimensions (" XorY-Txt ") to align: "))
(setq ENTS (ssget Filter))
(cond
((and
(setq ENTS (jlgg-SSToList ENTS))
(setq ENTS
(vl-remove-if-not
(function
(lambda (eDim / Code70)
(setq Code70 (cdr (assoc 70 (entget eDim))))
(and (= 6 (logand 6 Code70))
(= XorY (logand 64 Code70)))
)
)
ENTS
)
)
)
)
(T
(prompt (strcat "\nNot Selected dimensions (" XorY-Txt ") to align: "))
(setq ENTS nil)
)
)
);; while
(command "OSMODE" 0)
;;Aling Dims:
(AlignTextDims ENTS)
(command "OSMODE" OSPRE)
(princ)
)
