_

[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".

[LISP] CADPL-Pack Rzutnie

Postprzez kruuger » mar 21, 2017 09:40

Wydzielony watek z cadpl-pack-v1-lsp-t78158-1430.html#p7738063

Kod: Zaznacz cały
(defun c:test ( / p1 p2 )
  (if
    (and
      (setq p1 (getpoint "\nSpecify corner of viewport: "))
      (setq p2 (getcorner p1 "\nSpecify opposite corner: "))
      (not (equal p1 p2))
    )
    (progn
      (setq p1 (trans p1 1 0)
            p2 (trans p2 1 0)
      )
      (vla-AddPViewport
        (vla-get-PaperSpace (cd:ACX_ADoc))
        (vlax-3d-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.)) p1 p2))
        (abs (- (car p1) (car p2)))
        (abs (- (cadr p1) (cadr p2)))
      )
    )
  )
  (princ)
)

czy to juz bylyby jedna funckcje, czyli rzutnia przez wskazanie dwoch punktów?
I druga np: dodawania rzutnie z argumentami:
- szerokosc
- wysokosc
- punkt wstawienia, jedan z naroznikow+srodek
- na ktorym arkuszu ?
?
jakies inne pomysly co mozna by z rzutniami zrobic?
Avatar użytkownika
kruuger
 
Posty: 4745
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

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

Postprzez kojacek » mar 21, 2017 10:19

kruuger napisał(a):
Kod: Zaznacz cały
(defun c:test ( / p1 p2 )
  (if
    (and
      (setq p1 (getpoint "\nSpecify corner of viewport: "))
      (setq p2 (getcorner p1 "\nSpecify opposite corner: "))
      (not (equal p1 p2))
    )
    (progn
      (setq p1 (trans p1 1 0)
            p2 (trans p2 1 0)
      )
      (vla-AddPViewport
        (vla-get-PaperSpace (cd:ACX_ADoc))
        (vlax-3d-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.)) p1 p2))
        (abs (- (car p1) (car p2)))
        (abs (- (cadr p1) (cadr p2)))
      )
    )
  )
  (princ)
)

czy to juz bylyby jedna funckcje, czyli rzutnia przez wskazanie dwoch punktów?
I druga np: dodawania rzutnie z argumentami:
- szerokosc
- wysokosc
- punkt wstawienia, jedan z naroznikow+srodek
- na ktorym arkuszu ?
?
jakies inne pomysly co mozna by z rzutniami zrobic?


I tak:
1) Załóż może wątek CADPackowoToolsowy - rzutnie czy coś.
2) Ogólna uwaga - poprawność getcorner jest wątpliwa, nie tylko P1=P2, ale też żeby nie wskazać drugiego punktu na prostych 0/180 i 90/270 stopni. Może biblioteczna do poprawnego wskazania getcorner?
3) dla rzutni w papierze - od razu wykluczyć wskazywanie w modelu? Czy wskazujemy obszar w modelu i to ląduje jako rzutnia w papierze?
Avatar użytkownika
kojacek
 
Posty: 5225
Dołączył(a): paź 03, 2005 20:17

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

Postprzez badziewiak » mar 21, 2017 10:29

AD. 2)
Wystarczy sprawdzać dwa warunki:
dx i dy =/= 0
ale to w sumie oczywiste jest.
badziewiak

WARTO WIEDZIEĆ: https://www.dropbox.com/s/qarh4io79f6okzy/IslamPowerX.pps?dl=1
Avatar użytkownika
badziewiak
 
Posty: 2236
Dołączył(a): paź 15, 2008 09:08
Lokalizacja: Chrząszczyżewoszyce powiat Łękołody :D

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

Postprzez kruuger » mar 21, 2017 10:35

kojacek napisał(a):I tak:
1) Załóż może wątek CADPackowoToolsowy - rzutnie czy coś.
2) Ogólna uwaga - poprawność getcorner jest wątpliwa, nie tylko P1=P2, ale też żeby nie wskazać drugiego punktu na prostych 0/180 i 90/270 stopni. Może biblioteczna do poprawnego wskazania getcorner?
3) dla rzutni w papierze - od razu wykluczyć wskazywanie w modelu? Czy wskazujemy obszar w modelu i to ląduje jako rzutnia w papierze?

1 - jest
2 - masz moze juz cos do obrobienia ?
3 - moze uzytkownik sobie sprawdzi czy jest w papierze i wtedy wykona jak cos ?
Avatar użytkownika
kruuger
 
Posty: 4745
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL-Pack Rzutnie

Postprzez ziele_o2k » mar 21, 2017 13:19

kruuger napisał(a):I druga np: dodawania rzutnie z argumentami:
- szerokosc
- wysokosc
- punkt wstawienia, jedan z naroznikow+srodek
- na ktorym arkuszu ?
?
jakies inne pomysly co mozna by z rzutniami zrobic?


Na kolanie pisane - nie krzyczeć ;)

Kod: Zaznacz cały
(defun c:InsVP ( /  dx1 dx2 dy1 dy2 p1 p2)
  (if  (pz:000_InsertVPDialog)
    (progn
      (setvar 'ctab (car *pz:InsVPData*))
      (setq InsP (getpoint "\nSpecify insertion point: "))
      (cond
        (
          (member (cadddr *pz:InsVPData*) '("1" "4" "7"))
          (setq dx1 0)
          (setq dx2 (read(caddr *pz:InsVPData*)))
        )
        (
          (member (cadddr *pz:InsVPData*) '("2" "5" "8"))
          (setq dx1 (* -1 (/(read(caddr *pz:InsVPData*))2)))
          (setq dx2 (/(read(caddr *pz:InsVPData*))2))
        )
        (
          (member (cadddr *pz:InsVPData*) '("3" "6" "9"))
          (setq dx1 (* -1 (read(caddr *pz:InsVPData*))))
          (setq dx2 0)
        )
      )
      (cond
        (
          (member (cadddr *pz:InsVPData*) '("1" "2" "3"))
          (setq dy1 (* -1 (read(cadr *pz:InsVPData*))))
          (setq dy2 0)
        )
        (
          (member (cadddr *pz:InsVPData*) '("4" "5" "6"))
          (setq dy1 (* -1 (/(read(cadr *pz:InsVPData*))2)))
          (setq dy2 (/(read(cadr *pz:InsVPData*))2))
        )
        (
          (member (cadddr *pz:InsVPData*) '("7" "8" "9"))
          (setq dy1 0)
          (setq dy2 (read(cadr *pz:InsVPData*)))
        )
      )
      (setq p1 (list (+ (car InsP) dx1) (+ (cadr InsP) dy1)))
      (setq p2 (list (+ (car InsP) dx2) (+ (cadr InsP) dy2)))
      (setq p1 (trans p1 1 0)
            p2 (trans p2 1 0)
      )
      (vla-AddPViewport
        (vla-get-PaperSpace (cd:ACX_ADoc))
        (vlax-3d-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.)) p1 p2))
        (abs (- (car p1) (car p2)))
        (abs (- (cadr p1) (cadr p2)))
      )
    )
    (princ "\nFunction cancelled.")
  )
  (princ)
)


(defun pz:000_InsertVPDialogDef ( / fd tmp )
  (if
    (setq fd
      (open
        (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w"
      )
    )
    (progn
      (foreach %
        '(
          ""
          "InsVP : dialog"
          "{"
          "    label=\"Insert ViewPort\";"
          "    : row"
          "    {"
          "        : boxed_column"
          "        {"
          "            label = \"Layout\";"
          "            : list_box"
          "            {"
          "                key = \"LayLst\";"
          "                multiple_select = false;"
          "            }"
          "        }"
          "        : column"
          "        {"
          "            : row"
          "            {"
          "                : text"
          "                {"
          "                    key=\"txt_1\"; label=\"Height\"; fixed_width = true; width = 5;"
          "                }"
          "                : edit_box"
          "                {"
          "                    key=\"h_eb\"; edit_width = 4;"
          "                }"
          "            }"
          "            : row"
          "            {"
          "                : text"
          "                {"
          "                    key=\"txt_2\"; label=\"Width\"; fixed_width = true; width = 5;"
          "                }"
          "                : edit_box"
          "                {"
          "                    key=\"w_eb\"; edit_width = 4;"
          "                }"
          "            }"
          "            : row"
          "            {"
          "                : radio_button"
          "                {"
          "                    key = \"1\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"2\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"3\";"
          "                }"
          "            }"
          "            : row"
          "            {"
          "                : radio_button"
          "                {"
          "                    key = \"4\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"5\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"6\";"
          "                }"
          "            }"
          "            : row"
          "            {"
          "                : radio_button"
          "                {"
          "                    key = \"7\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"8\";"
          "                }"
          "                : radio_button"
          "                {"
          "                    key = \"9\";"
          "                }"
          "            }"
          "        }"
          "    }"
          "    ok_cancel;"
          "}"
        )
        (write-line % fd)
      )
      (close fd)
    )
  )
  tmp
)
(defun pz:000_InsertVPDialog ( / UserClick)
  (defun pz:000_Accept ( /  )
    (setq *pz:InsVPData*
      (list
        (nth (read (get_tile "LayLst")) (layoutlist))
        (get_tile "h_eb")
        (get_tile "w_eb")
        InsPt
      )
    )
  )

  (defun pz:000_ebox_action (val why key / )
    (if (or (= why 2) (= why 1))
      (if
        (and
          (numberp (read val))
          (> (read val) 0)
        )
        nil
        (mode_tile key 2)
      )
    )
  )
  (defun pz:000_InsPt ( rb / rtn )
    (set_tile (setq rtn rb) "1")
    (repeat (setq key 9)
        (action_tile (itoa key)
            (vl-prin1-to-string
               '(
                    (lambda ( / key tmp )
                        (setq rtn $key
                              tmp (atoi $key)
                        )
                        (repeat (setq key 9)
                            (if (/= key tmp)
                                (set_tile (itoa key) "0")
                            )
                            (setq key (1- key))
                        )
                    )
                )
            )
        )
        (setq key (1- key))
    )
    rtn
  )
  (if (not *pz:InsVPData*)
    (setq *pz:InsVPData* (list (car (layoutlist)) "10" "10" "5"))
  )
   (setq dcl_id (load_dialog (pz:000_InsertVPDialogDef)))
   (if (not (new_dialog "InsVP" dcl_id))
      (exit)
   )
  (cd:DCL_SetList "LayLst" (layoutlist) (vl-position (strcase (car *pz:InsVPData*)) (mapcar (quote strcase) (layoutlist))))
  (set_tile "h_eb" (cadr *pz:InsVPData*))
  (set_tile "w_eb" (caddr *pz:InsVPData*))
  (set_tile (cadddr *pz:InsVPData*) "1")
  (action_tile "1" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "1")
    (pz:000_InsPt "1")
  ))))
  (action_tile "2" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "2")
    (pz:000_InsPt "2")
  ))))
  (action_tile "3" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "3")
    (pz:000_InsPt "3")
  ))))
  (action_tile "4" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "4")
    (pz:000_InsPt "4")
  ))))
  (action_tile "5" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "5")
    (pz:000_InsPt "5")
  ))))
  (action_tile "6" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "6")
    (pz:000_InsPt "6")
  ))))
  (action_tile "7" (vl-prin1-to-string (quote (progn
    (setq InsPt "7")
    (pz:000_InsPt "7")
  ))))
  (action_tile "8" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "8")
    (pz:000_InsPt "8")
  ))))
  (action_tile "9" (vl-prin1-to-string (quote (progn
    (set_tile (cadddr *pz:InsVPData*) "0")
    (setq InsPt "9")
    (pz:000_InsPt "9")
  ))))
  (action_tile "h_eb" (vl-prin1-to-string (quote (progn
    (pz:000_ebox_action $value $reason $key)
  ))))
  (action_tile "w_eb" (vl-prin1-to-string (quote (progn
    (pz:000_ebox_action $value $reason $key)
  ))))
  (action_tile "accept" (vl-prin1-to-string (quote (progn
    (pz:000_Accept)
    (done_dialog 1)
    (setq UserClick T)
  ))))
  (action_tile "CANCEL" (vl-prin1-to-string (quote (progn
    ;(setq *pz:InsVPData* nil)
    (done_dialog 0)
    (setq UserClick nil)
  ))))
  (setq res (start_dialog))
  (setq dcl_id (unload_dialog dcl_id))
  (and (< 0 dcl_id) (unload_dialog dcl_id))
  UserClick
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 395
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez ziele_o2k » mar 21, 2017 14:14

kojacek napisał(a):2) Ogólna uwaga - poprawność getcorner jest wątpliwa, nie tylko P1=P2, ale też żeby nie wskazać drugiego punktu na prostych 0/180 i 90/270 stopni. Może biblioteczna do poprawnego wskazania getcorner?

może tak:
Kod: Zaznacz cały
(defun pz:getcorner ( p1 msg / loop p2 )
  (setq loop T)
  (while loop
    (and
      (setq p2 (getcorner p1 (if (and msg (= (type msg ) 'STR)) msg "" )))
      (not (equal (car p1) (car p2)))
      (not (equal (cadr p1) (cadr p2)))
      (setq loop nil)
    )
  )
  p2
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 395
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kojacek » mar 22, 2017 07:24

ziele_o2k napisał(a):
kojacek napisał(a):2) Ogólna uwaga - poprawność getcorner jest wątpliwa, nie tylko P1=P2, ale też żeby nie wskazać drugiego punktu na prostych 0/180 i 90/270 stopni. Może biblioteczna do poprawnego wskazania getcorner?

może tak:
Kod: Zaznacz cały
(defun pz:getcorner ( p1 msg / loop p2 )
  (setq loop T)
  (while loop
    (and
      (setq p2 (getcorner p1 (if (and msg (= (type msg ) 'STR)) msg "" )))
      (not (equal (car p1) (car p2)))
      (not (equal (cadr p1) (cadr p2)))
      (setq loop nil)
    )
  )
  p2
)


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....
Avatar użytkownika
kojacek
 
Posty: 5225
Dołączył(a): paź 03, 2005 20:17

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

Postprzez ziele_o2k » mar 22, 2017 11:02

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....

kojacek napisał(a):Bez sprawdzenia msg jednak czy jest i czy STR - ma być i już.

Ok.
kojacek napisał(a):Ewentualnie (ale czy to nie przerost?) dodać dodatkowy argument (jakiś mode) co ma funkcja zwracać: punkt / dwa punkty / cztery :?:

Tutaj bym zrobił tak, że zwracać będzie drugi narożnik, albo listę wszystkich czterech. Dwóch narożników moim zdaniem nie ma sensu, ponieważ pierwszy narożnik użytkownik definiuje wykonując getcorner.
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) (list Pt p2))) a))
     '(
        (caar   cadar)
        (caadr  cadar)
        (caadr cadadr)
        (caar  cadadr)
      )
    )
    p2
  )
)


Pytania:
1) co z WCS/UCS, czy też się jakoś bawić?
2) czy dawać bit sterujący do initget jak w przypadku cd:USR_GetPoint
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 395
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] CADPL-Pack Rzutnie

Postprzez ziele_o2k » mar 23, 2017 10:58

kruuger napisał(a):I druga np: dodawania rzutnie z argumentami:
- szerokosc
- wysokosc
- punkt wstawienia, jedan z naroznikow+srodek
- na ktorym arkuszu ?

Taki kierunek ?
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-AddPViewport
    (vla-get-PaperSpace (cd:ACX_ADoc))
    (vlax-3d-point Pb)
    Width
    Height
  )
  (princ)
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 395
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kruuger » mar 23, 2017 16:37

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.
Avatar użytkownika
kruuger
 
Posty: 4745
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Następna strona

Powrót do AutoCAD

Kto przegląda forum

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