_

[LISP] łuk multilinia

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: [LISP] łuk multilinia

Postprzez wilda » wrz 14, 2017 11:01

A jakie niedoskonałości jeszcze posiada poza tą że nie można wstawić łuku?
Do tej pory nie wiele jej stosowałem głównie dlatego że nie mogłem wyokrąglić załamań!
wilda
 
Posty: 198
Dołączył(a): gru 18, 2007 21:41

Re: [LISP] łuk multilinia

Postprzez SOYER__1 » wrz 15, 2017 09:07

Dla mnie głównym problemem bywa zawodność połączeń między mutiliniami .
Nawet proste łączenie naroża 90st czasem nie chce się wykonać nie wspominając o bardziej skomplikowanych (dostępnych)połączeniach.
Innym problemem jest brak możliwości wykonania niektórych połączen pomiędzy multiliniami - np : zwężenie lub poszerzenie ML (ew lokalna zmiana szerokości na prostym odcinku) . Połączenia wykonują się tylko na liniach bocznych ML - a na liniach końcowych już nie (jeśli mamy ML zamkniętą na końcach) .
Czasami występują również dziwne problemy z brakiem ciągłości lini tworzących ML.
Uciążliwa jest też ujemna skala szerokości przy zlustrowanych ML .
Pewnie jeszcze by się coś znalazło ...
ML_problemy.jpg
SOYER__1
 
Posty: 68
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] łuk multilinia

Postprzez wilda » paź 12, 2017 01:11

kojacek napisał(a):Póki co pierwsze próby dają takie coś <klik>:

Tak dobrze szło i coś się zatrzymało.
Może mogę jakoś pomóc?
wilda
 
Posty: 198
Dołączył(a): gru 18, 2007 21:41

Re: [LISP] łuk multilinia

Postprzez kojacek » paź 12, 2017 15:27

wilda napisał(a):Tak dobrze szło i coś się zatrzymało. Może mogę jakoś pomóc?


Czując się wywołanym do tablicy... Na szybko taki szkic prototypu (jeszcze z błędami) polecenia FML. Są tam command-y żeby działało, nie miałem (z wielu powodów) specjalnie czasu, aby to poprzerabiać na funkcje które przeliczają geometrię, a trochę by tego było, przeczuwam... W zasadzie taka pierwsza zgrubna wersja do testowania. Może ktoś zechce przy tym trochę podziubać i poprawić - zapraszam. Działa ogólnie tak <klik>:
filletmline1.gif

Ale zdarzają się sytuacje gdy działa niezbyt dobrze. Tak jak tu <klik>:
filletmline2.gif

Przyznam że, nie wyczuwam jeszcze dlaczego tak się dzieje.

Tutaj cały kod:
Kod: Zaznacz cały
; ------------------------------------------------------------------ ;
; C:FML - zoakragla multilinie.
; 12-10-2017 - prototyp z bledami jeszcze
; kojacek
; ------------------------------------------------------------------ ;
(defun C:FML (/ s1 e1 d1 s2 e2 d2 o1 o2 dp da c p r ch ad sc x f
                LM:Bulge->Arc -getm -geta -getp -midp -marc -mlsdata 
             )
  ;; Bulge to Arc  -  Lee Mac
  ;; p1 - start vertex
  ;; p2 - end vertex
  ;; b  - bulge
  ;; Returns: (<center> <start angle> <end angle> <radius>)
  (defun LM:Bulge->Arc (p1 p2 b / a c r \)
    (setq a (* 2 (atan b))
          r (/ (distance p1 p2) 2 (sin a))
          c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)
    )
    (if (minusp b)
      (list c (angle c p2)(angle c p1)(abs r))
      (list c (angle c p1)(angle c p2)(abs r))
    )
  )
; ---->
  (defun -getp (e / d p w x a)
    (setq d (entget e)
          p (cd:DXF_Massoc 11 d)
          w (cdr (assoc 70 d))
          x (* 0.5 (cdr (assoc 40 d)))
          a (-geta e)
    )
    (mapcar
      '(lambda (%)
         (cond
           ( (= 0 w)(polar % (+ (* 1.5 pi) a) x)) ;gora
           ( (= 1 w) %)
           ( (= 2 w)(polar % (+ (* 0.5 pi) a) x)) ;dol
           (t nil)
         )
       ) p
    )
  )
; ---->
  (defun -geta (e)
    (angle '(0 0 0)
      (cdr (assoc 12 (entget e)))
    )
  )
; ---->
  (defun -getm (e / r)
    (if
      (and
        (= "MLINE" (cdr (assoc 0 (setq r (entget e)))))
        (= 2 (cdr (assoc 72 r)))
      )
      r
    )
  )
  (defun -midp (p1 p2)
    (mapcar '(lambda (%1 %2)(/ (+ %1 %2) 2.0)) p1 p2)
  )
; ---->
  (defun -marc (Data Obj Scl / e d)
    (foreach % Data
      (cond
        ( (zerop (car %))
          (cd:ENT_SetDXF Obj 62 (cadr %))
          (cd:ENT_SetDXF Obj 6 (caddr %))
        )
        (t (setq e
             (vlax-vla-object->ename
               (car
                 (vlax-safearray->list
                   (vlax-variant-value
                     (vla-offset
                       (vlax-ename->vla-object Obj)(* -1 Scl (car %))
                     )
                   )
                 )
               )
             )
           )
           (cd:ENT_SetDXF e 62 (cadr %))
           (cd:ENT_SetDXF e 6 (caddr %))
        )
      )
    )
    (if (not (member '0 (mapcar '(lambda (%)(car %)) Data)))
      (entdel Obj)
    )
  )
; ---->
  (defun -mlsdata (Name / d r)
    (setq d
      (entget
        (cd:DCT_GetDict
          (cd:DCT_GetDict (namedobjdict) "ACAD_MLINESTYLE")
          Name
        )
      )
          d (cdr (vl-remove-if '
                    (lambda (%)(not (member (car %)'(49 62 6)))) d)
            )
    )
    (while d
      (setq %
        (list (cdr (assoc 49 d))(cdr (assoc 62 d))(cdr (assoc 6 d)))
            d (cdddr d)
            r (append (list %) r)
      )
    )
    r
  )
;;; =============================================
  (if
    (and
      (setq s1 (entsel "\nWybierz pierwszą multilinię: "))
      (setq d1 (-getm (setq e1 (car s1))))
    )
    (if
      (and
        (setq s2 (entsel "\nWybierz drugą multilinię: "))
        (setq d2 (-getm (setq e2 (car s2))))
      )
      (if
        (not (equal e1 e2))
        (if
          (setq r (getdist "\nPodaj promień: "))
          (progn
            (setvar "FILLETRAD" r)
            (setq o1 (-getp e1)
                  o2 (-getp e2)
                  c (inters (car o1)(cadr o1)(car o2)(cadr o2) nil)
                  ch (getvar "CMDECHO")
                  ad (-mlsdata (cdr (assoc 2 (entget e1))))
            )
            (cd:SYS_UndoBegin)
            (setq p
              (cd:ENT_MakeLWPolyline
                (getvar "CTAB")
                (list
                  (-midp (car o1)(cadr o1))
                  c
                  (-midp (car o2)(cadr o2))
                ) nil
              )
            )
            (redraw p 2)
            (setvar "CMDECHO" 0)
            (command "_.FILLET" "_P" p)
            (setvar "CMDECHO" ch)
            (setq dp (entget p))
            (if
              (> (cdr (assoc 90 dp)) 3)
              (progn   
                (setq sc (cdr (assoc 40 (entget e1)))
                      dp (vl-remove-if-not
                           '(lambda (%)
                              (or (= (car %) 10)(= (car %) 42)))
                           dp
                         )
                      dp (vl-remove-if
                           '(lambda (%)
                              (and (= (car %) 42)(zerop (cdr %))))
                           dp
                         )
                      dp (cdr (reverse (cdr (reverse dp))))
                      da (LM:Bulge->Arc (cdar dp)(cdaddr dp)(cdadr dp))
                )
                (entdel p)
                (setq f (cd:ENT_MakeLWPolyline (getvar "CTAB")
                          (list
                            (polar (car da)(cadr da)(* 1.5 (last da)))
                            (car da)
                            (polar (car da)(caddr da)(* 1.5 (last da)))
                           ) nil
                        )
                )
                (redraw f 2)
                (setq x
                  (cd:ENT_MakeArc
                    (getvar "CTAB")
                    (car da)(last da)(cadr da)(caddr da) T
                  )
                )
                (-marc ad x sc)
                (setvar "CMDECHO" 0)
                (command "_.EXTEND" f "" (ssget (cadr s1))(ssget (cadr s2)) "")
                (setvar "CMDECHO" ch)
                (entdel f)
                (cd:SYS_UndoEnd)
              )
              (progn
                (entdel p)
                (princ "\nNie można zaokrąglić - promień jest za duży. ")
              )
            )
          )
          (princ "\nNie podano promienia zaokrąglenia. ")
        )
        (princ "\nWskazano tę samą multilinię. ")
      )
      (princ "\nNależy wskazać jednosegmentową multilinię. ")
    )
    (princ "\nNależy wskazać jednosegmentowa multilinie. ")
  )
  (princ)
)
; ---
(princ)


Oczywiście bez Pack-a się nie obejdzie...
Testujcie :)
Avatar użytkownika
kojacek
 
Posty: 5293
Dołączył(a): paź 03, 2005 20:17

Re: [LISP] łuk multilinia

Postprzez wilda » paź 12, 2017 23:05

Testujemy.
Różne dziwne rzeczy na razie się dzieją.
Poniżej dwa przykłady.
Myślałem że to będzie prostsza sprawa z tym zaokrąglaniem.
Załączniki
multilinia.gif
multilinia2.gif
multilinia3.gif
wilda
 
Posty: 198
Dołączył(a): gru 18, 2007 21:41

Re: [LISP] łuk multilinia

Postprzez kojacek » paź 12, 2017 23:20

wilda napisał(a):Myślałem że to będzie prostsza sprawa z tym zaokrąglaniem.

No cuda. Jedno na pewno jest wiadome. Jeżeli promień zaokrąglenia "zachodzi" na jedną (lub) obie MLINE, na pewno będzie się badziewić. W tej chwili MLINE są zawsze wydłużane. W rzeczywistości mogą być nie tylko wydłużane, ale też ucinane. Inna sprawa: kierunki MLINE. Niektóre mogą być lustrzanie odbite i (chyba) stąd biorą się błędy w odsuwaniu łuku. Przeczuwałem że, nie będzie łatwo...
Avatar użytkownika
kojacek
 
Posty: 5293
Dołączył(a): paź 03, 2005 20:17

Re: [LISP] łuk multilinia

Postprzez wilda » paź 13, 2017 02:06

Nie jestem w stanie przeanalizować w jaki sposób program realizuje zaokrąglanie ale wydaje mi się że nie jest to tak jak sobie wymyśliłem na początku wątku - za bardzo skomplikowane kod wygląda.
Mój sposób myślenia o realizacji tego zadania (patrz rysunki) wykorzystywał tylko dane z istniejących i powstających elementów rysunkowych. Dlatego wydawało mi się że nie jest to takie trudne.
A więc jeszcze raz trochę zmodyfikowany schemat działania. Program powinien:
- rys. 2 narysować dwie linie rysowane na podstawie punktów początku i końca multilinii,
- rys. 3 wstawić łuk pomiędzy tymi dwoma liniami - przy wstawianiu łuku linie automatycznie wydłużają się/skracają do końców łuku,
- rys 4. odczytać nowe punkty początkowe i końcowe zmienionych linii i przesunąć punkty końcowy/początkowy multilini do odczytanych punktów wydłużonych/skróconych linii odpowiadających każdej multilinii,
- rys. 5. i 6 program kasuje pomocnicze linie i kopiuje łuk równolegle o szerokość multilinii.
Załączniki
multi.jpg
wilda
 
Posty: 198
Dołączył(a): gru 18, 2007 21:41

Poprzednia strona

Powrót do AutoCAD

Kto przegląda forum

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