표안의 문자 정렬

[달수]

아키모아의 질문글을 아임피러님이 답변한 내용중

두 가지 문제점이 있어서 새롭게 만들어 봤습니다.

1. 중복문자 문제 - 굳이 중복문자를 제거 안해도 되지만 도면 관리상 하는게 좋을거 같습니다.

2. 표안에 빈공간이 있어도 정렬되게 유도

   - 아임피러님은 가로의 문자갯수가 동일해야만 작동됨

   - 객체 이동을 시키면 가로의 문자갯수가 동일하지 않아도 됨

3. 질문자 샘플도면 

0122정렬.dwg

;==================================================================================================

; 테이블 내용 정렬시키기 (Create by MrLISP 달수 2017.01.24) 카페주소 http://cafe.daum.net/notcolor/

;==================================================================================================

(defun c:aa (/ *error* _mrSta _mrEnd gv gvL  _mrSetSort _mrTextOverKill _as _df _df10 _su _mrMove ss newSS Lst)

(defun *error* (msg)(_mrEnd)

(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))

(princ (strcat "\n** Error: " msg " **")))(princ)

)

(defun _mrSta ()

(and (= 8 (logand 8 (getvar 'UNDOCTL)))(vla-endundomark acDoc))

(vla-startundomark acDoc)

(setq gv (mapcar 'getvar (setq gvL '("CMDECHO"))))

(mapcar 'setvar gvL '(0))

)

(defun _mrEnd ()(and gvL gv (mapcar 'setvar gvL gv))(vla-endundomark acDoc))

(defun _mrEname2Obj (ss)

(mapcar 'vlax-ename->vla-object 

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

)

)

(defun _mrSetSort (ss m yg / tH sL nL tp Y tL L)

(defun sAs (num x)(cdr (assoc num x)))

(defun sE (x) (vl-remove-if 'listp (mapcar 'cadr (ssnamex x))))

(defun sI (x / a72 a73)

(if (= (sAs 0 x) "TEXT")(setq a72 (sAs 72 x) a73 (sAs 73 x)))

(if (and a72 a73 (/= a72 0)(/= a73 0))(sAs 11 x)(sAs 10 x))

)

(defun sSy (x / d)(setq d (if (member m '(1 4 6 7)) < >))

(cond ((member m '(1 2 3 4))(vl-sort x '(lambda (x1 x2)(d (caar x1) (caar x2)))))

((member m '(5 6 7 8))(vl-sort x '(lambda (x1 x2)(d (cadar x1) (cadar x2)))))))

(defun sSx (x / d)(setq d (if (member m '(1 3 6 8)) > <))

(cond ((member m '(1 2 3 4))(vl-sort x '(lambda (x1 x2)(d (cadaar x1) (cadaar x2)))))

((member m '(5 6 7 8))(vl-sort x '(lambda (x1 x2)(d (caaar x1) (caaar x2)))))))

(defun sRa (x)(cond ((member m '(1 2 3 4))(if (< (- (cadr x) tH) Y (+ (cadr x) tH)) T nil))

((member m '(5 6 7 8))(if (< (- (car x) tH) Y (+ (car x) tH)) T nil))))

(defun sLs (x)(if (sRa (car x))(setq sL (cons x sL))(setq tp (cons x tp))))

(defun sLf (x) (cond ((member m '(1 2 3 4))(setq Y (cadar x)))

((member m '(5 6 7 8))(setq Y (caar x))))

(mapcar 'sLs nL)(setq sL (sSy sL) tL (cons sL tL) nL tp sL '() tp '()))

(defun yMx (e / o)(setq o (vlax-ename->vla-object e))(vla-getboundingbox o 'mi 'mx)

(- (cadr (vlax-safearray->list mx))(cadr (vlax-safearray->list mi))))

(setq L (sSy (mapcar '(lambda (x) (list (sI (entget x)) x))(sE ss))))

(setq tH (* (yMx (cadar L)) yg) nL L)

(mapcar '(lambda (x)(if (member x nL)(sLf x))) L)

(mapcar '(lambda(x) (mapcar 'cadr x))(sSx tL))

)

(defun _mrTextOverKill (ss / _FD L1 L2 L3 newSS)

(defun _FD (L)

(if (car L)

(cons 

(car L)

(_FD

(vl-remove-if

(function

(lambda (x)

(and

(equal (vlax-get (car L) 'InsertionPoint)(vlax-get x 'InsertionPoint) 0.001)

(= (vla-get-Alignment (car L))(vla-get-Alignment x))

(= (vla-get-Height (car L))(vla-get-Height x))

(= (vla-get-Rotation (car L))(vla-get-Rotation x))

(= (vla-get-StyleName (car L))(vla-get-StyleName x))

(= (vla-get-TextString (car L))(vla-get-TextString x))

)

)

)

L

)

)

)

)

)

(setq L1

(mapcar 'vlax-ename->vla-object 

(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

)

)

(setq L2 (_FD L1))

(if (setq L3 (vl-remove-if (function (lambda (x) (member x L2))) L1))

(foreach o L3 (vla-delete o))

)

(setq newSS (ssadd))

(foreach o L2 (setq newSS (ssadd (vlax-vla-object->ename o) newSS)))

newSS

)

(defun _as (n)

(cond ((< 64 n 91) (- n 64))((< 96 n 123) (- n 95.9))((> 128 n) (+ n 99999))(t n))

)

(defun _df (e)(cdr (assoc 1 (entget e))))

(defun _df10 (e)(caddr (assoc 10 (entget e))))

(defun _su (L)(append (list (_as (ascii (substr (cadr (mapcar '_df L)) 1 1)))) L))

(defun _mrMove (y L / oPt mPt)

(setq oPt (cdr (assoc 10 (entget (car L)))))

(setq mPt (list (car oPt) y 0.))

(foreach e L

(vlax-invoke (vlax-ename->vla-object e) 'move oPt mPt)

)

)

(vl-load-com)

(setq acObj (vlax-get-acad-object))

(setq acDoc (vla-get-activedocument acObj))

(_mrSta)

(and

(setq ss (ssget '((0 . "text"))))

(setq newSS (_mrTextOverKill ss)) ; 중복 문자 삭제

(setq Lst (_mrSetSort newSS 1 0.8))

(mapcar '_mrMove

(mapcar '_df10 (mapcar 'car Lst))

(mapcar 'cdr (vl-sort (mapcar '_su Lst)(function (lambda (x1 x2)(< (car x1)(car x2))))))

)

)(_mrEnd)(princ)

)

(princ "\n [카페주소 : http://cafe.daum.net/notcolor/ 명령어 : AA ]")(princ)

표정렬1.lsp

[아임피러]

역시 업어 갑니다

[Green]

아키모아 에서 왔습니다.~~
감사 드려요~.(- -)(_ _)(- -)