;;;------------------------------------------------------------------------
;;;|  Seçilen obje gurubu içindeki tüm (2D) Solid objeleri seçerek,       |
;;;|  renklerine göre guruplandırır. Her guruptaki Solid objelerden önce  |
;;;|  PoLyLine objerleri oluşturup bunları Region'a çevirdikten sonra     |
;;;|  her guruba kendi içinde Union komutu uygulayarak birleştirir.       |
;;;|  oluşturulan bileşik Region'lar explode edilerek, yeni oluşan        |
;;;|  Line objeleri Pedit ile birleştirilerek sınırları belirleyen        |
;;;|  PoLyLine objeleri oluşturulur.                                      |
;;;|                 Hazırlayan M. Şahin Güvercin  www.autocadokulu.com   |
;;;------------------------------------------------------------------------
(defun c:Kontur (/ Obj L n cLrs cLr M o ObG pLns pvt Lob Lb PeO)
  (command "_.undo" "group") (setvar "cmdecho" 0)
  (setvar "modemacro" "Prepared by: M. S. Guvercin")
  (setq Obj (ssget (list (cons 0 "solid"))) L (sslength Obj) n -1 cLrs nil)
  (while (< (setq n (1+ n)) L)
    (setq cLrs (append cLrs (list (cdr (assoc 62 (entget (ssname Obj n))))))))
  (setq L (length cLrs) n -1)
  (while (< (setq n (1+ n)) L)
    (setq cLr (nth n cLrs) cLrs (append (list cLr) (vl-remove cLr cLrs))
          L (length cLrs)))
  (setq cLrs (vl-sort cLrs '<) n -1)
  (while (< (setq n (1+ n)) L)
    (command "select" Obj "")
    (setq ObG (ssget "p" (list (cons 0 "solid") (cons 62 (nth n cLrs))))
          M (sslength ObG) o -1 pLns (ssadd))
    (while (< (setq o (1+ o)) M)
      (setq pvt (entget (ssname ObG o)))
      (entmake
        (list '(0 . "lwpolyline") '(100 . "AcDbEntity") '(67 . 0) (assoc 8 pvt)
              (cons 62 (nth n cLrs)) '(100 . "AcDbPolyline") '(90 . 4)
              '(70 . 129) '(43 . 0.0) '(38 . 0.0) '(39 . 0.0)
              (cons 10 (cdr (assoc 10 pvt))) '(40 . 0.0) '(41 . 0.0)
              '(42 . 0.0) '(91 . 0) (cons 10 (cdr (assoc 11 pvt))) '(40 . 0.0)
              '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 (cdr (assoc 12 pvt)))
              '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0)
              (cons 10 (cdr (assoc 13 pvt))) '(40 . 0.0) '(41 . 0.0)
              '(42 . 0.0) '(91 . 0)))
      (setq pLns (ssadd (entlast) pLns)))
    (setq LOb (entlast) Lb Lob Unns (ssadd))
    (command "_.region" pLns "")
    (while (setq Lb (entnext Lb)) (setq Unns (ssadd Lb Unns)))
    (command "_.union" Unns "")
    (setq Lb Lob)
    (while (setq Lb (entnext Lb)) (if (= "REGION" (cdr (assoc 0 (entget Lb))))
                                    (command "_.explode" Lb)))
    (setq Lb Lob PeO (ssadd))
    (while (setq Lb (entnext Lb)) (setq PeO (ssadd Lb PeO)))
    (command "_.pedit" "m" PeO ""
             (if (= 0 (getvar "peditaccept")) "y") "j" "0.0000" ""))
  (command "_.erase" Obj "")
  (command "_.undo" "e") (prin1)
)
(princ "\nKomut Adı: KONTUR, Hazırlayan M.Şahin güvercin-www.autocadokulu.com")
(prin1)