Re: 레이어명을 블럭으로 만들기 문의

[도도도]

;; 블럭이름 중복시 "-1,-2 ,-3....." 추가

(defun c:BBT ( / lay lst ss ll elst tlst i)

    (if (setq ss (ssget '((-4 . "<NOT") (0 . "insert")(-4 . "NOT>"))))

        (progn

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

                (setq lay (cdr (assoc 8 (entget x))))

                (if (not (member lay lst))

                    (setq lst (cons lay lst))

                )

            )

            (setq lst (vl-sort lst '(lambda (l1 l2) (> l1 l2))))

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

            (mapcar

                '(lambda (l / ll)

                    (mapcar

                        '(lambda (o)

                            (if (= l (cdr (assoc 8 (entget o))))

                                (progn

                                    (setq ll (cons o ll))

                                    (setq elst (vl-remove-if '(lambda (x) (= x o)) elst))

                                )

                            )

                        )

                        elst

                    )

                    (setq tlst (cons ll tlst))

                )

                lst

            )

        )

    )

    (setq i 1)

    (mapcar

        '(lambda (x / n obj LL UR bounds xmin ymin xmax ymax p)

            (setq n (cdr (assoc 8 (entget (car x)))))

            (while (tblsearch "BLOCK" n)

                (setq n (strcat (cdr (assoc 8 (entget (car x)))) "-" (itoa i)))

                (setq i (1+ i))

            )

            (foreach obj (mapcar 'vlax-ename->vla-object x)

                (vla-getboundingbox obj 'LL 'UR)

                (setq LL (vlax-safearray->list LL) UR (vlax-safearray->list UR))

                (setq bounds (cons LL (cons UR bounds)))

            )

            (setq

                xmin (apply 'min (mapcar 'car bounds))

                ymin (apply 'min (mapcar 'cadr bounds))

                xmax (apply 'max (mapcar 'car bounds))

                ymax (apply 'max (mapcar 'cadr bounds))

            )

            (setq p (mapcar '* '(0.5 0.5 0.5)(list (+ xmin xmax)(+ ymin ymax) 0.0)))

            (entmake (list '(0 . "BLOCK") '(8 . "0") (cons 2 n) (cons 10 p) '(70 . 0)))

            (foreach e x

                (entmake (entget e))

                (entdel e)

            )

            (if (setq n (entmake '((0 . "ENDBLK") (8 . "0"))))

                (entmake

                    (list

                        '(0 . "INSERT")

                        (cons  2 n)

                        (cons 10 p)

                    )

                )

            )

            (setq i 1)

        )

        tlst

    )

    (princ)

)

[몽키]

정말 감사합니다..^^