_

Obrys polilini + automatyczny hatch

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Re: Obrys polilini + automatyczny hatch

Postprzez ziele_o2k » mar 08, 2018 23:27

kojacek napisał(a):(...) command-em - przyznam nie chciało mi się dziobać poważniej... ;)(...)

Jako i mnie 8)

Ja na kolanie (aż wstyd pokazywać ten kod) napisałem coś takiego jak niżej. Jest to wersja z wydłużeniem końców polilinii, odpowiednika z mojego wcześniejszego gifa już nie mam, a nie chce mi się wracać do tego, bo kojackowa wersja jest gites majonez :)
Kod: Zaznacz cały
(defun c:trt ( / _obs _pln_cl1 _pln_cl2 enames _ss _obj enx)
  (setq _obj (vlax-ename->vla-object (car (entsel))))
  (setq offset 0.5)
  (mapcar
    (function
      (lambda ( o )
        (vl-catch-all-error-p
          (setq o
            (vl-catch-all-apply
              (function vlax-invoke) (list _obj 'Offset o)
            )
          )
        )
        (setq _obs (cons o _obs))
      )
    )
    (list offset (- offset))
  )
  (setq _obs (mapcar 'car _obs))
  (foreach % _obs
    (setq enx (entget (vlax-vla-object->ename %)))
    (entmod
        (append
            (reverse (member (assoc 39 enx) (reverse enx)))
            (apply 'append (LM:dex:extendpoly (LM:lwvertices enx) offset))
            (list (assoc 210 enx))
        )
    )
  )
  (setq _pln_cl1
    (cd:ACX_AddLWPolyline (cd:ACX_ASpace) (list
    (trans (vlax-curve-getEndPoint (car _obs)) 0 1)
    (trans (vlax-curve-getEndPoint (cadr _obs)) 0 1))
    nil)
  )
  (setq _pln_cl2
    (cd:ACX_AddLWPolyline (cd:ACX_ASpace) (list
    (trans (vlax-curve-getStartPoint (car _obs)) 0 1)
    (trans (vlax-curve-getStartPoint (cadr _obs)) 0 1))
    nil)
  )
  (setq enames
    (mapcar
      'vlax-vla-object->ename
      (list _pln_cl1 _pln_cl2 (car _obs) (cadr _obs))
    )
  )
  (setq _ss (ssadd))
  (foreach % enames
    (ssadd % _ss)
  )
  (command "_.pedit" "_m" _ss "" "_j" "" "")
  (setq _bound (vlax-ename->vla-object (entlast)))

  (setq h (vlax-invoke
            (vla-get-block (vla-get-activelayout (cd:ACX_ADoc)))
            'addhatch
            acHatchObject
            (getvar "hpname")
            (if (= (getvar "hpassoc") 1)
              :vlax-true
              :vlax-false)))
  (vlax-invoke h 'appendouterloop (list _bound))
  (vlax-put h 'patternangle (getvar "hpang"))
  (vlax-put h 'patternscale (getvar "hpscale"))
  (vla-evaluate h)

  (princ)
)

A tutaj funkcje do wydłużania plini skopiowane gdzieś od Lee Maca:
Kod: Zaznacz cały
(defun LM:dex:extendpoly ( lst ext / ang bul cen dis len pt1 pt2 pt3 rad )
    (setq pt1 (cdr (assoc 10 (car  lst)))
          pt2 (cdr (assoc 10 (cadr lst)))
          bul (cdr (assoc 42 (car  lst)))
          dis (distance pt1 pt2)
    )
    (if (equal 0.0 bul 1e-8)
        (if (not (equal 0.0 dis 1e-8))
            (setq dis (/ (+ dis ext) dis)
                  lst
                (cons
                    (subst
                        (cons  10 (mapcar '+ pt2 (vxs (mapcar '- pt1 pt2) dis)))
                        (assoc 10 (car lst))
                        (car lst)
                    )
                    (cdr lst)
                )
            )
        )
        (progn
            (setq cen (LM:bulgecentre pt1 pt2 bul)
                  rad (/ (* dis (1+ (* bul bul))) 4 (abs bul))
                  len (abs (* 4 (atan bul) rad))
            )
            (if (< (+ len ext) (* rad 2 pi))
                (setq pt3 (polar cen ((if (minusp bul) + -) (angle cen pt1) (/ ext rad)) rad)
                      ang ((if (minusp bul) - +) (atan bul) (/ ext rad 4.0))
                      lst
                    (cons
                        (subst
                            (cons  10 pt3)
                            (assoc 10 (car lst))
                            (subst
                                (cons  42 (/ (sin ang) (cos ang)))
                                (assoc 42 (car lst))
                                (car lst)
                            )
                        )
                        (cdr lst)
                    )
                )
            )
        )
    )
    (setq lst (reverse lst)
          pt1 (cdr (assoc 10 (car  lst)))
          pt2 (cdr (assoc 10 (cadr lst)))
          bul (cdr (assoc 42 (cadr lst)))
          dis (distance pt1 pt2)
    )
    (if (equal 0.0 bul 1e-8)
        (if (not (equal 0.0 dis 1e-8))
            (setq dis (/ (+ dis ext) dis)
                  lst
                (cons
                    (subst
                        (cons  10 (mapcar '+ pt2 (vxs (mapcar '- pt1 pt2) dis)))
                        (assoc 10 (car lst))
                        (car lst)
                    )
                    (cdr lst)
                )
            )
        )
        (progn
            (setq cen (LM:bulgecentre pt2 pt1 bul)
                  rad (/ (* dis (1+ (* bul bul))) 4 (abs bul))
                  len (abs (* 4 (atan bul) rad))
            )
            (if (< (+ len ext) (* rad 2 pi))
                (setq pt3 (polar cen ((if (minusp bul) - +) (angle cen pt1) (/ ext rad)) rad)
                      ang ((if (minusp bul) - +) (atan bul) (/ ext rad 4.0))
                      lst
                    (vl-list*
                        (subst
                            (cons  10 pt3)
                            (assoc 10 (car lst))
                            (car lst)
                        )
                        (subst
                            (cons  42 (/ (sin ang) (cos ang)))
                            (assoc 42 (cadr lst))
                            (cadr lst)
                        )
                        (cddr lst)
                    )
                )
            )
        )
    )
    (reverse lst)
)

(defun LM:lwvertices ( e )
  (if (setq e (member (assoc 10 e) e))
    (cons
      (list
        (assoc 10 e)
        (assoc 40 e)
        (assoc 41 e)
        (assoc 42 e)
      )
      (LM:lwvertices (cdr e))
    )
  )
)

 
(defun LM:bulgecentre ( p1 p2 b )
    (polar p1
        (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
        (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
    )
)

Wracając do kojackowego lispa, dodałbym jedynie sprawdzajkę, czy się polilinia nie przecina sama ze sobą. Oczywiście w przypadku tego konkretnego zastosowania (gazociąg), nie ma o tym mowy, ale jakby komuś przyszło do czegoś innego używać tego lispa, to ma gotowe rozwiązanie.
Kod: Zaznacz cały
; =============================================================== ;
; HPoly.lsp by kojacek (08-03-2018)
; Mod by ziele_o2k -> Self-Intersection test (08-03-2018)
; --------------------------------------------------------------- ;
(setq *X* 0.5        ; offset
      *S* 0.1        ; pattern scale
      *H* "ANSI31"   ; pattern name
      *C* 252        ; color
)
; --------------------------------------------------------------- ;
(defun C:HPO (/ s x f d i v a b c g p -mp -mh)
  (defun -mp (a b c d / cmd)
    (setq cmd (getvar "CMDECHO"))
    (setvar "CMDECHO" 0)
    (vl-cmdf "_.Pedit" a "_j" c b d "" "_exit")
    (setvar "CMDECHO" cmd)
    (vlax-ename->vla-object (entlast))
  )
  (defun -mh (o /  h a)
    (setq h (vla-AddHatch
              (cd:ACX_ASpace)
              acHatchPatternTypePredefined *H* :vlax-true))
    (setq a (vlax-make-safearray vlax-vbObject (cons 0 0))
          a (vlax-safearray-fill a (list o))
    )
    (vla-AppendOuterLoop h a)
    (vla-put-PatternScale h *S*)
    (vla-Evaluate h)
    (foreach % (list o h)(vla-put-Color % *C*))
  )

  (initget "Zmień")
  (setq s
    (entsel
      (strcat "\nAktualna szerokość ("
              (cd:CON_Real2Str *X* 2 nil)
              ") [Zmień] lub wybierz polilinię:"))
  )
  (if s
    (cond
      ( (= s "Zmień")
        (initget (+ 1 2 4))
        (setq x (getdist
                  "\nNowa szerokość: "))
        (if x
          (progn
            (setq *X* x)
            (C:HPO)
          )
          (princ "\nAnulowano. ")
        )
      )
      ( (= (type (setq i (car s)))'ENAME)
        (cond
          ( (= (cdr (assoc 0 (setq f (entget i)))) "LWPOLYLINE")
            (cond
              ( (= 1 (logand 1 (cdr (assoc 70 f))))
                (princ "\nPolilinia jest zamknieta. Spróbuj ponownie.")
                (C:HPO)
              )
              ( (polylineSelfCrossing i)
                (princ "\nPolilinia przecina się ze sobą. Spróbuj ponownie.")
                (C:HPO)
              )
              (t
                (setq d (/ *X* 2.0)
                      v (vlax-ename->vla-object (car s))
                )
                (cd:SYS_UndoBegin)
                (vla-offset v d)
                (setq a (entlast))
                (vla-offset v (* -1 d))
                (setq b (entlast)
                      c (entget a)
                      g (entget b)
                )
                (-mh
                  (-mp
                    a
                    b
                    (cd:ENT_MakeLWPolyline
                      (getvar "CTAB")
                      (list
                        (cdr (assoc 10 c))
                        (cdr (assoc 10 g))) nil
                    )
                    (cd:ENT_MakeLWPolyline
                      (getvar "CTAB")
                      (list
                        (cdr (assoc 10 (reverse c)))
                        (cdr (assoc 10 (reverse g)))) nil
                    )
                  )
                )
                (cd:SYS_UndoEnd)
              )
            )
          )
          ( t
            (princ "\nTo nie jest polilinia. Spróbuj ponownie.")
            (C:HPO)
          )
        )
      )
      (t (princ "\nAnulowano."))
    )
    (princ "\nNic nie wybrano.")
  )
  (princ)
)
; --------------------------------------------------------------- ;
(princ)


;;  Function name: PSC = Polyline Self-Crossing
;;  To determine whether a Polyline of any type Crosses itSelf.
;;  With 3D Polylines, must have true intersection in 3D,
;;  not apparent in 2D.
;;  Returns T if self-crossing, nil if not.
;;  by Kent Cooper
(defun polylineSelfCrossing (poly / pltyp plobj plverts plints)
  (vl-load-com)
  (setq
    pltyp (cdr (assoc 0 (entget poly)))
    plobj (vlax-ename->vla-object poly)
    plverts (length
              (safearray-value
                (variant-value (vla-get-Coordinates plobj))))
    plints (/ (length
                (safearray-value
                  (variant-value
                    (vla-intersectwith plobj plobj acExtendNone)))) 3)
  ); end setq
  (setq plverts (/ plverts (if (= pltyp "LWPOLYLINE") 2 3)))
  (if (vlax-curve-isClosed poly)
    (< plverts plints); then - closed
    (if (equal (vlax-curve-getStartPoint poly)
               (vlax-curve-getEndPoint poly) 1e-8); else - open
      (<= plverts plints); then - start/end at same place
      (<= plverts (1+ plints)); else - open
    ); end if
  ); end if
); end defun
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 719
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Obrys polilini + automatyczny hatch

Postprzez kojacek » mar 08, 2018 23:40

Nie przesadzaj z tym wstydem, Twój kod jest dobry. Dzięki za uzupełnienie zapobiegające wyboru samoprzecinającej się poly. Tego mi brakowało. Co do wywalenia command (jako pedit) mam taki pomysł:
Odsuwasz poly na lewo / prawo. z każdego pobierasz DXF (punkty + bulge). Łączysz w jedną listę [pierwsza lista] + [łącznik (tylko zerowe bulge)] + [odwrócona kolejność wierzchołków z drugiej listy]. To wszystko do entmake + zamknięcie na koniec.
Chyba powinno zadziałać (?). Wymazujesz dwie stare i jest jedna zamknięta poly.
Avatar użytkownika
kojacek
 
Posty: 5447
Dołączył(a): paź 03, 2005 20:17

Re: Obrys polilini + automatyczny hatch

Postprzez ziele_o2k » mar 09, 2018 00:16

kojacek napisał(a):(...) Dzięki za uzupełnienie zapobiegające wyboru samoprzecinającej się poly. Tego mi brakowało. (...)

a sprawdzajkę znalazłem tutaj :Dhttp://forum.cad.pl/operacje-na-poliliniach-t85363-10.html#p7706709
kojacek napisał(a):(...)z każdego pobierasz DXF (punkty + bulge). Łączysz w jedną listę [pierwsza lista] + [łącznik (tylko zerowe bulge)] + [odwrócona kolejność wierzchołków z drugiej listy]. To wszystko do entmake + zamknięcie na koniec.
Chyba powinno zadziałać (?). Wymazujesz dwie stare i jest jedna zamknięta poly.

Ten sam pomysł miałem, dopisze się.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 719
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Obrys polilini + automatyczny hatch

Postprzez kojacek » mar 09, 2018 07:10

ziele_o2k napisał(a):
kojacek napisał(a):(...) Dzięki za uzupełnienie zapobiegające wyboru samoprzecinającej się poly. Tego mi brakowało. (...)

a sprawdzajkę znalazłem tutaj :Dhttp://forum.cad.pl/operacje-na-poliliniach-t85363-10.html#p7706709
kojacek napisał(a):(...)z każdego pobierasz DXF (punkty + bulge). Łączysz w jedną listę [pierwsza lista] + [łącznik (tylko zerowe bulge)] + [odwrócona kolejność wierzchołków z drugiej listy]. To wszystko do entmake + zamknięcie na koniec.
Chyba powinno zadziałać (?). Wymazujesz dwie stare i jest jedna zamknięta poly.

Ten sam pomysł miałem, dopisze się.


Tu nadal się haczy z samoprzecinaniem. To działa dobrze przy wyborze polilinii źródłowej do odsunięcia. Są jednak przypadki że już odsunięty obrys się samoprzecina, co powoduje błąd przy próbie kreskowania. Trzeba to jeszcze tam wszyć.
Avatar użytkownika
kojacek
 
Posty: 5447
Dołączył(a): paź 03, 2005 20:17

Re: Obrys polilini + automatyczny hatch

Postprzez kg91 » mar 09, 2018 09:17

Jest super, miałbym tylko jeszcze jedną prośbę. Gazociąg wiadomo jest polilinią, ale od takiej sieci gazowej odchodzą też przyłącza do budynków które też są rysowane polilinią i taki przyłącz ma punkt wspólny z rysowaną siecią. W obecnym skrypcie mogę wybrać jedną polilinię, zakreskować, wybrac kolejną i zakreskować przez co wspólny obszar jest zakreskowany dwa razy i krzyżuje się. może dało by się wybrać więcej polilini (wszystkie) potwierdzić komendę żeby ten hatch był odsunięty? Problem pokazują dwa screeny, jeden po wykoanniu operacji skryptem a drugi po wykonaniu ręcznie.


Aby kolor hatchu i linii nie był "252" a "bylayer" wystarczy zmienić 252 na bylayer w lispie i działa - to tak dla potomnych.
Załączniki
2.jpg
1.jpg
kg91
 
Posty: 19
Dołączył(a): lut 14, 2018 10:44

Re: Obrys polilini + automatyczny hatch

Postprzez ziele_o2k » mar 09, 2018 10:05

To już niestety jest wyższa szkoła jazdy i ja nie znajdę czasu, żeby napisać lispa pod to.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 719
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Obrys polilini + automatyczny hatch

Postprzez kojacek » mar 09, 2018 10:34

ziele_o2k napisał(a):To już niestety jest wyższa szkoła jazdy i ja nie znajdę czasu, żeby napisać lispa pod to.


Jest to niemniej możliwe (wiem mniej więcej jak można by to zrobić), ale (mam obawy) dość pracochłonne. Myślę się, że przy wielu (nie wiadomo czy 2-3 czy 50-100 obiektów) dużych i długich poliliniach o stosunkowo skomplikowanej (załamania "zakręty" itp.) geometrii może takie coś już nie działać poprawnie.
Avatar użytkownika
kojacek
 
Posty: 5447
Dołączył(a): paź 03, 2005 20:17

Re: Obrys polilini + automatyczny hatch

Postprzez ziele_o2k » mar 09, 2018 11:03

kojacek napisał(a):
ziele_o2k napisał(a):To już niestety jest wyższa szkoła jazdy i ja nie znajdę czasu, żeby napisać lispa pod to.


Jest to niemniej możliwe (wiem mniej więcej jak można by to zrobić), ale (mam obawy) dość pracochłonne. Myślę się, że przy wielu (nie wiadomo czy 2-3 czy 50-100 obiektów) dużych i długich poliliniach o stosunkowo skomplikowanej (załamania "zakręty" itp.) geometrii może takie coś już nie działać poprawnie.

Si, ja bym może sugerował zostawić to tak jak jest teraz (ewentualnie zamiast entsela, dać ssgeta?). Do tego oddzielne polecenie do poprawiania tych styków, chociaż pytanie czy zwykłe trim cadowe nie jest wystarczające.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 719
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Obrys polilini + automatyczny hatch

Postprzez kojacek » mar 09, 2018 11:12

ziele_o2k napisał(a):
Si, ja bym może sugerował zostawić to tak jak jest teraz (ewentualnie zamiast entsela, dać ssgeta?). Do tego oddzielne polecenie do poprawiania tych styków, chociaż pytanie czy zwykłe trim cadowe nie jest wystarczające.


Jak dasz ssget-a, to nie masz słowa kluczowego zmiany szerokości w wywołaniu, wtedy trzeba budować drugi poziom wyborów... albo osobne polecenie do ustawień.
Avatar użytkownika
kojacek
 
Posty: 5447
Dołączył(a): paź 03, 2005 20:17

Re: Obrys polilini + automatyczny hatch

Postprzez ziele_o2k » mar 09, 2018 12:09

kojacek napisał(a):
ziele_o2k napisał(a):
Si, ja bym może sugerował zostawić to tak jak jest teraz (ewentualnie zamiast entsela, dać ssgeta?). Do tego oddzielne polecenie do poprawiania tych styków, chociaż pytanie czy zwykłe trim cadowe nie jest wystarczające.


Jak dasz ssget-a, to nie masz słowa kluczowego zmiany szerokości w wywołaniu, wtedy trzeba budować drugi poziom wyborów... albo osobne polecenie do ustawień.

Wiem, wiem... boli mnie ten brak initgeta przy ssget'cie. Ja to u siebie rozwiązuje, tak że mam po odpaleniu polecenia getkworda gdzie jest [Dalej/Ustawienia] i domyślnie Dalej, jeżeli wduszę spację to przechodzi do ssgeta, a jeśli dam U to odpalają się ustawienia. Trochę to denerwowało mnie na początku, ale się przestawiłem i już pamiętam, że dwa razy spację wdusić.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 719
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Poprzednia stronaNastępna strona

Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników