_

[LISP] CADPL-Pack Rzutnie

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] CADPL-Pack-v1.lsp [Dyskusja]

Postprzez kojacek » mar 23, 2017 21:46

kruuger napisał(a):
kojacek napisał(a):O w tym kierunku bym poszedł. Bez sprawdzenia msg jednak czy jest i czy STR - ma być i już. Ewentualnie (ale czy to nie przerost?) dodać dodatkowy argument (jakiś mode) co ma funkcja zwracać: punkt / dwa punkty / cztery :?: i do Pack'a w najbliższej przyszłości....

ze cztery to niby do wyrysowania prostokata? w sumie czemu nie.
k.

Tak jak ziele_o2k zapodał:
Kod: Zaznacz cały
(cd:ACX_AddLWPolyline (cd:ACX_ASpace)(cd:USR_GetCorner (getpoint "\n1::: ") "\n2::: " T) T)
Avatar użytkownika
kojacek
 
Posty: 5235
Dołączył(a): paź 03, 2005 20:17

Re: [LISP] CADPL-Pack-v1.lsp [Dyskusja]

Postprzez kruuger » mar 23, 2017 23:23

kojacek napisał(a):
kruuger napisał(a):
kojacek napisał(a):O w tym kierunku bym poszedł. Bez sprawdzenia msg jednak czy jest i czy STR - ma być i już. Ewentualnie (ale czy to nie przerost?) dodać dodatkowy argument (jakiś mode) co ma funkcja zwracać: punkt / dwa punkty / cztery :?: i do Pack'a w najbliższej przyszłości....

ze cztery to niby do wyrysowania prostokata? w sumie czemu nie.
k.

Tak jak ziele_o2k zapodał:
Kod: Zaznacz cały
(cd:ACX_AddLWPolyline (cd:ACX_ASpace)(cd:USR_GetCorner (getpoint "\n1::: ") "\n2::: " T) T)

aa slepy juz chyba jestem.
1. co do rzutni to fajnie dziala. pytanie czy wlaczamy ja domyslenie DisplayOn? chyba tak - cd:ACX_AddViewport ?
2. co do corner. to czy list nie powinna byc zwrocona zawsze od lewego dolnego wierzcholka i przeciwnie do wskazowek? niezaleznie do wybranej cwiartki? ewentualnie tak jak teraz + info o cwiartce, ale to chyba lekko zamotane. konieczne do rysowania czegos od-do, musimy znac kolejnosc.
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack-v1.lsp [Dyskusja]

Postprzez ziele_o2k » mar 23, 2017 23:49

kruuger napisał(a):1. co do rzutni to fajnie dziala. pytanie czy wlaczamy ja domyslenie DisplayOn? chyba tak - cd:ACX_AddViewport ?

Moim zdaniem DisplayOn - tak
Kod: Zaznacz cały
; =========================================================================================== ;
; Wstawianie rzutni / Insert ViewPort                                                         ;
;  Pb     [LIST]   - punkt bazowy / base point                                                ;
;  Width  [REAL]   - szerokość rzutni / ViewPort width                                        ;
;  Height [REAL]   - wysokość rzutni / ViewPort height                                        ;
;  HJust  [INT]    - wyrównanie w poziomie / horizontal justification                         ;
;                    1 - Lewo / Left; 2 - Środek / Center; 3 - Prawo / Right                  ;
;  VJust [T/nil]   - wyrównanie w pionie / vertical justification                             ;
;                    1 - Góra / Top; 2 - Środek / Middle; 3 - Dół / Bottom                    ;
; ------------------------------------------------------------------------------------------- ;
; (pz:InsVPort (getpoint) 100 100 1 3)                                                        ;
; =========================================================================================== ;
(defun pz:InsVPort ( Pb Width Height HJust VJust /  )
  (setq
    Pb (trans Pb 1 0)
  )
  (cond
    ((= HJust 1) (setq Pb (list (+ (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))))
    ((= HJust 3) (setq Pb (list (- (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))))
  )
  (cond
    ((= VJust 1) (setq Pb (list (car Pb) (- (cadr Pb) (/ Height 2)) (caddr Pb))))
    ((= VJust 3) (setq Pb (list (car Pb) (+ (cadr Pb) (/ Height 2)) (caddr Pb))))
  )
  (vla-Display 
    (vla-AddPViewport
      (vla-get-PaperSpace (cd:ACX_ADoc))
      (vlax-3d-point Pb)
      Width
      Height
    )
    :vlax-true
  )
  (princ)
)



kruuger napisał(a):2. co do corner. to czy list nie powinna byc zwrocona zawsze od lewego dolnego wierzcholka i przeciwnie do wskazowek? niezaleznie do wybranej cwiartki? ewentualnie tak jak teraz + info o cwiartce, ale to chyba lekko zamotane. konieczne do rysowania czegos od-do, musimy znac kolejnosc.

Hehe, napisałem kolejność jaką zwraca, a takiej nie zwracało :) (moim zdaniem pierwsza opcja - od lewego dolnego wierzcholka i przeciwnie do wskazowek
Poprawione
Kod: Zaznacz cały
; =========================================================================================== ;
; Pobranie drugiego narożnika prostokąta / Get second corner of rectangle                     ;
;  Pt   [LIST]     - punkt bazowy / base point                                                ;
;  Msg  [STR]      - komunikat do wyswietlenia / message to display                           ;
;  Mode [T/nil]    - typ zwracanych danych / type of returned data                            ;
;                    nil = drugi narożnik / second corner                                     ;
;                    T   = lista wsołrzędnych w kolejności: DL DP GP GL                       ;
;                          list of coordinates in order: LL LR UR UL                          ;
; ------------------------------------------------------------------------------------------- ;
; (cd:USR_GetCorner (getpoint) "\nWskaż drugi narożnik: " T)                                  ;
; =========================================================================================== ;
(defun cd:USR_GetCorner ( Pt Msg Mode / loop p2 )
  (setq loop T)
  (while loop
    (and
      (setq p2 (getcorner Pt Msg))
      (not (equal (car Pt) (car p2)))
      (not (equal (cadr Pt) (cadr p2)))
      (setq loop nil)
    )
  )
  (if Mode
    (mapcar
     '(lambda ( a )
        (mapcar
         '(lambda ( b )
            ( (eval b)
              (vl-sort (list Pt p2)
               '(lambda (%1 %2)
                  (< (car %1) (car %2))
                )
              )
            )
          )
          a
        )
      )
     '(
        (caar   cadar)
        (caadr  cadar)
        (caadr cadadr)
        (caar  cadadr)
      )
    )
    p2
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 470
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] CADPL-Pack-v1.lsp [Dyskusja]

Postprzez kruuger » mar 24, 2017 00:06

ziele_o2k napisał(a):Hehe, napisałem kolejność jaką zwraca, a takiej nie zwracało :) (moim zdaniem pierwsza opcja - od lewego dolnego wierzcholka i przeciwnie do wskazowek
Poprawione

rzutnie mysle mozna by dodac. ale corner nie tak szybko
zawsze powinno byc od DL. Wskazanie DL-GP i odwrotnie jest ok. A wskaz teraz DP-GL i odwrotnie.
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack-v1.lsp [Dyskusja]

Postprzez ziele_o2k » mar 24, 2017 02:34

kruuger napisał(a):rzutnie mysle mozna by dodac. ale corner nie tak szybko
zawsze powinno byc od DL. Wskazanie DL-GP i odwrotnie jest ok. A wskaz teraz DP-GL i odwrotnie.

Bydzie
Kod: Zaznacz cały
; =========================================================================================== ;
; Pobranie drugiego narożnika prostokąta / Get second corner of rectangle                     ;
;  Pt   [LIST]     - punkt bazowy / base point                                                ;
;  Msg  [STR]      - komunikat do wyswietlenia / message to display                           ;
;  Mode [T/nil]    - typ zwracanych danych / type of returned data                            ;
;                    nil = drugi narożnik / second corner                                     ;
;                    T   = lista wsołrzędnych w kolejności: DL DP GP GL                       ;
;                          list of coordinates in order: LL LR UR UL                          ;
; ------------------------------------------------------------------------------------------- ;
; (cd:USR_GetCorner (getpoint) "\nWskaż drugi narożnik: " T)                                  ;
; =========================================================================================== ;
(defun cd:USR_GetCorner ( Pt Msg Mode / loop P2 Lsp )
  (setq loop T)
  (while loop
    (and
      (setq P2 (getcorner Pt Msg))
      (not (equal (car Pt) (car P2)))
      (not (equal (cadr Pt) (cadr P2)))
      (setq loop nil)
    )
  )
  (if Mode
    (progn
      (setq Lst
        (mapcar
         '(lambda (%1)
            (mapcar (quote(eval %1)) (list Pt P2))
          )
         '(car cadr)
        )
      )
      (mapcar
       '(lambda (%1)
          (mapcar
           '(lambda (%2 %3)
              (apply (quote(eval %2)) %3)
            )
            %1 Lst
          )
        )
       '(
          (min min)
          (max min)
          (max max)
          (min max)
        )
      )
    )
    P2
  )
)

W ramach zabawy:
Kod: Zaznacz cały
(defun c:test1 ( / pz:Ent_MakeSolidHatch Pts Dst)
 
  (defun pz:Ent_MakeSolidHatch ( L )
    (entmakex
      (apply
      'append
        (list
          (list
            '(0 . "HATCH")
            '(100 . "AcDbEntity")
            '(410 . "Model")
            '(100 . "AcDbHatch")
            '(10 0.0 0.0 0.0)
            '(210 0.0 0.0 1.0)
            (cons 2 "SOLID")
            '(70 . 1)
            '(71 . 0)
            '(91 . 1)
          )
          (apply 'append
            (list
              (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length L)))
              (mapcar '(lambda (b) (cons 10 b)) L)
              '((97 . 0))
            )
          )
          (list '(75 . 0)
          '(76 . 1)
          '(47 . 1.)
          '(98 . 2)
          '(10 0. 0. 0.0)
          '(10 0. 0. 0.0)
          '(450 . 0)
          '(451 . 0)
          '(460 . 0.0)
          '(461 . 0.0)
          '(452 . 0)
          '(462 . 0.0)
          '(453 . 2)
          '(463 . 0.0)
          '(63 . 256)
          '(463 . 1.0)
          '(63 . 256)
          '(470 . "LINEAR")
          )
        )
      )
    )
  )
  (if
    (setq Pts (cd:USR_GetCorner (getpoint "\nWskaż pierwszy punkt: ") "\nWskaż drugi punkt: " T))
    (progn
      (setq
        Dst (* 0.3 (min (distance (car Pts) (cadr Pts)) (distance (car Pts) (cadddr Pts))))
        Pts (cd:LST_ReplaceItem 1 Pts (polar (cadddr Pts) (* -1 (/ pi 4)) Dst))
      )
      (cd:SYS_UndoBegin)
      (pz:Ent_MakeSolidHatch Pts)
      (cd:SYS_UndoEnd)
      (princ)
    )
  )
  (princ)
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 470
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] CADPL-Pack Rzutnie

Postprzez kruuger » mar 24, 2017 11:21

corner potestuja, a do rzutni chyba fajnie dodac jeszcze Space gdzie chcemy go polozyc.
Tak mamy jak np rysujemy linie, poly itp.
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack Rzutnie

Postprzez kruuger » mar 24, 2017 11:37

Kod: Zaznacz cały
(defun cd:ACX_AddViewport (Space Pb Width Height HJust VJust / obj)
  (setq Pb (trans Pb 1 0))
  (cond
    ( (= HJust 1) (setq Pb (list (+ (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))) )
    ( (= HJust 3) (setq Pb (list (- (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))) )
  )
  (cond
    ( (= VJust 1) (setq Pb (list (car Pb) (- (cadr Pb) (/ Height 2)) (caddr Pb))) )
    ( (= VJust 3) (setq Pb (list (car Pb) (+ (cadr Pb) (/ Height 2)) (caddr Pb))) )
  )
  (vla-Display 
    (setq obj
      (vla-AddPViewport
        (vla-get-PaperSpace Space)
        (vlax-3d-point Pb)
        Width
        Height
      )
    )
    :vlax-true
  )
   obj
)
(cd:ACX_AddViewport (cd:ACX_ADoc) (getpoint) 100 100 1 3)

Space i zwracamy obj
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack Rzutnie

Postprzez ziele_o2k » mar 24, 2017 13:19

kruuger napisał(a):
Kod: Zaznacz cały
(cd:ACX_AddViewport (cd:ACX_ADoc) (getpoint) 100 100 1 3)

Space i zwracamy obj

A dlaczego nie tak?
Kod: Zaznacz cały
(defun cd:ACX_AddViewport (Space Pb Width Height HJust VJust / obj)
  (setq Pb (trans Pb 1 0))
  (cond
    ( (= HJust 1) (setq Pb (list (+ (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))) )
    ( (= HJust 3) (setq Pb (list (- (car Pb) (/ Width 2)) (cadr Pb) (caddr Pb))) )
  )
  (cond
    ( (= VJust 1) (setq Pb (list (car Pb) (- (cadr Pb) (/ Height 2)) (caddr Pb))) )
    ( (= VJust 3) (setq Pb (list (car Pb) (+ (cadr Pb) (/ Height 2)) (caddr Pb))) )
  )
  (vla-Display 
    (setq obj
      (vla-AddPViewport
        Space
        (vlax-3d-point Pb)
        Width
        Height
      )
    )
    :vlax-true
  )
   obj
)

i tak:
Kod: Zaznacz cały
(cd:ACX_AddViewport (cd:ACX_Paper) (getpoint) 100 100 1 3)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 470
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] CADPL-Pack Rzutnie

Postprzez kruuger » mar 24, 2017 13:24

ziele_o2k napisał(a):i tak:

oczywiscie ze tak. sprawdzam czy czuwacie ;)
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack Rzutnie

Postprzez kojacek » mar 24, 2017 13:44

kruuger napisał(a):oczywiscie ze tak. sprawdzam czy czuwacie ;)

ja żem przysnął... (piątek) ;)
Avatar użytkownika
kojacek
 
Posty: 5235
Dołączył(a): paź 03, 2005 20:17

Poprzednia stronaNastępna strona

Powrót do AutoCAD

Kto przegląda forum

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