AutoCAD... AutoLISP... VisualLISP...

  [20] Obwiednia regionu

index  
  Jak odczytać współrzędne wierzchołków regionu? Problem zgłoszony na forum www.cad.pl. Nie jest to łatwa sprawa ponieważ, obiekty typu region nie posiadają dostępnych informacji na temat swojej geometrii, z poziomu lisp-a (ani też innego narzędzia). Zważywszy jeszcze możliwości dowolnie różnych kształtów regionów (krawędziami mogą być łuki, linie, mogą występować wyspy itp.) problem komplikuje się jeszcze bardziej. Chyba najbardziej rozsądnym pomysłem może być tutaj wykorzystanie polecenia _BPOLY (funkcja BPOLY), rysująca polilinię (lub region) tworząc zamknięte obszary na podstawie znalezionych granic. Pomysł polega na utworzeniu polilini w obszarze ograniczonym regionem, a prostokątem go obejmującym. Poniżej zilustrowane są kolejne kroki takiego działania:
  Ponizej kod funkcji jk:ENT_GetRegionBond oraz funkcji pomocniczych jk:DXF_massoc i jk:SSX_SS->List: 
; =============================================================================== ;
; jk:ENT_GetRegionBond * kojacek * 10-09-2009 *                                   ;
; Rysuje i zwraca ENAME zewnetrznej obwiedni regionu [e] jako polilinie           ;
; Wywolanie np.: (jk:ENT_GetRegionBond (car (entsel)))                            ;
; =============================================================================== ;
(vl-load-com)
(defun jk:ENT_GetRegionBond (e / dt vo bb pl p1 p2 p3 p4 ds pt CMD CEC
                                 nl ze ss lo lp Res 
                            )
  (if
    (= (cdr (assoc 0 (setq dt (entget e)))) "REGION")
    (progn
      (setq vo (vlax-ename->vla-object e)
            bb (vla-GetBoundingBox vo 'p1 'p2)
            pl (mapcar 'vlax-safearray->list (list p1 p2))
            p1 (car pl)
            p2 (cadr pl)
            p3 (list (car p2)(cadr p1))
            p4 (list (car p1)(cadr p2))
            ds (distance p1 p2)
            pt (polar p3 0.0 (/ ds 100.0))
            CMD (getvar "CMDECHO")
            CEC (getvar "CECOLOR")
      )
      (if
        (entmake
          (append
            '( (0 . "LWPOLYLINE")(100 . "AcDbEntity")
             (62 . 40)(100 . "AcDbPolyline")
             (90 . 4)(70 . 1))
             (list (cons 10 (list (car p1)(cadr p1)))
                   (cons 10 p3)
                   (cons 10 (list (car p2)(cadr p2)))
                   (cons 10 p4))
          )
        )
        (progn
          (setq nl (entlast))
          (vla-offset (vlax-ename->vla-object nl)(/ ds 50.0))
          (setq ze (entlast))
          (entdel nl)
          (setvar "CMDECHO" 0)
          (setvar "CECOLOR" "40")
          (bpoly)(vl-cmdf "_A" "_O" "_P" "" pt "")
          (setvar "CECOLOR" CEC)
          (setvar "CMDECHO" CMD)
          (setq pl (jk:DXF_massoc 10 (entget ze)))
          (entdel ze)
          (if
            (setq ss (ssget "_CP" pl '((0 . "*POLY*"))))
            (progn
              (setq lo (jk:SSX_SS->List ss)
                    lo (mapcar
                         '(lambda (%)
                           (cons (vla-get-Area
                                   (vlax-ename->vla-object %)
                                 ) %
                           )
                         ) lo
                       )
                    lp (vl-sort (mapcar '(lambda (%)(car %)) lo) '>)
              )
              (entdel (cdr (assoc (car lp) lo)))
              (setq lp (cddr lp)
                    Res (cdadr lo)
                    lo (cddr lo)
              )
              (if lo (foreach % lo (entdel (cdr %))))
              Res
            )
          )
        )
      )
    )
  )
)
; =============================================================================== ;
; "multiple" assoc                                                                ;
; =============================================================================== ;
(defun jk:DXF_massoc (k l / r)
  (foreach % l
    (if (eq k (car %))
      (setq r (cons (cdr %) r))
    )
  )
  (reverse r)
)
; =============================================================================== ;
; zamienia zbior wskazan na liste ename                                           ;
; =============================================================================== ;
(defun jk:SSX_SS->List (sel / n l)
  (repeat 
    (setq n (sslength sel))
    (setq n (1- n) 
          l (cons (ssname sel n) l)
    )
  )
) 
; =============================================================================== ;
(princ)
 Na zakończenie kilka uwag. Funkcja jest "surowa". Oznacza to że w niektórych szczególnych sytuacjach może niepoprawnie działać. Moment krytyczne mogą wystąpić w następujacych sytuacjach: inne niż globalny układy współrzędnych, inne obiekty przecinające region (i/lub) znajdujące się w jego bezpośrednim sąsiedztwie, bardzo złożony i skomplikowany kształt regionu, szczególnie którego krawędzie składają się z łuków eliptycznych, krzywych typu spline, itp.