_

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

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 ziele_o2k » mar 23, 2017 19:42

Z czystej ciekawości, dlaczego to:

Kod: Zaznacz cały
(defun cd:SYS_GetFonts (/ lt reg ttfs ls shxs)
  (setq lt
    (vl-remove-if-not
      (function
        (lambda (%)(wcmatch % "*TrueType)"))
      )
      (vl-registry-descendents
        (setq reg
          (strcat "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
                  "Windows NT\\CurrentVersion\\Fonts"
          )
        ) ""
      )
    )
  )
  (setq ttfs
    (mapcar
      (function
        (lambda (%)
          (cons
            (vl-string-right-trim " (TrueType)" %)
            (vl-registry-read reg %)
          )
        )
      )
      (vl-remove-if-not
        (function
          (lambda (%1 / %2)
            (and
              (not
                (wcmatch
                  (setq %2 (vl-registry-read reg %1))
                  "*\\*"
                )
              )
              (wcmatch (strcase %2) "*.TTF")
            )
          )
        ) lt
      )
    )
        lt (mapcar (quote car) ttfs)
        ls (vl-directory-files
             (vl-filename-directory
               (findfile "isocp.shx")
             )
             "*.shx"
           )
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )
  (list
    (append lt ls)
    (append ttfs shxs)
  )
)

nie znalazło się w Packu?
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 678
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kruuger » mar 23, 2017 23:32

ziele_o2k napisał(a):Z czystej ciekawości, dlaczego to:

Kod: Zaznacz cały
(defun cd:SYS_GetFonts (/ lt reg ttfs ls shxs)
  (setq lt
    (vl-remove-if-not
      (function
        (lambda (%)(wcmatch % "*TrueType)"))
      )
      (vl-registry-descendents
        (setq reg
          (strcat "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
                  "Windows NT\\CurrentVersion\\Fonts"
          )
        ) ""
      )
    )
  )
  (setq ttfs
    (mapcar
      (function
        (lambda (%)
          (cons
            (vl-string-right-trim " (TrueType)" %)
            (vl-registry-read reg %)
          )
        )
      )
      (vl-remove-if-not
        (function
          (lambda (%1 / %2)
            (and
              (not
                (wcmatch
                  (setq %2 (vl-registry-read reg %1))
                  "*\\*"
                )
              )
              (wcmatch (strcase %2) "*.TTF")
            )
          )
        ) lt
      )
    )
        lt (mapcar (quote car) ttfs)
        ls (vl-directory-files
             (vl-filename-directory
               (findfile "isocp.shx")
             )
             "*.shx"
           )
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )
  (list
    (append lt ls)
    (append ttfs shxs)
  )
)

nie znalazło się w Packu?

sie gdzies zawieruszylo? czy to byla lista wszystkich czcionek z systemu czy bez jakichs tam ?
poprzypominam sobie te wszystkie help'y co i jak i zrobie update.
Avatar użytkownika
kruuger
 
Posty: 4823
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

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

Postprzez ziele_o2k » mar 24, 2017 15:58

kruuger napisał(a):sie gdzies zawieruszylo? czy to byla lista wszystkich czcionek z systemu czy bez jakichs tam ?
poprzypominam sobie te wszystkie help'y co i jak i zrobie update.


Gdzieś w tych okolicach to odkopałem:
Kod: Zaznacz cały
(defun cd:SYS_FontList (Path Ext)
   (cd:DCL_StdListDialog
     (vl-sort
        (vl-directory-files Path (strcat "*." Ext))
      (quote <)
     )
     0 "Fonty" (strcase Ext) 32 15 2 nil nil nil
   )
)
(cd:SYS_FontList (nth 1 (cd:SYS_FontPaths)) "shx")
(cd:SYS_FontList (nth 0 (cd:SYS_FontPaths)) "ttf")

Kod: Zaznacz cały
(defun cd:SYS_FontList (Path Ext / Poz res)
   (setq Poz (cd:DCL_StdListDialog
     (setq res (vl-sort
        (vl-directory-files Path (strcat "*." Ext))
      (quote <)
     ))
     0 "Fonty" (strcase Ext) 32 15 2 nil nil nil
   ))
   (if res(strcat Path "\\" (nth Poz res)))
)

Kod: Zaznacz cały
(vlax-for x (vla-get-TextStyles
         (vla-get-activedocument (vlax-get-acad-object))
       )
  (princ)
  (vla-setfont x "Georgia" :vlax-False :vlax-False 0 32)
)

;;; Zmiana czcionki dla wszystkich styli na np. SIMPLEX.SHX
(vlax-for x (vla-get-TextStyles
         (vla-get-activedocument (vlax-get-acad-object))
       )
  (princ)
  (vla-put-fontfile x "SIMPLEX") 
)

Kod: Zaznacz cały
;; sprawdza poprawnosc obiektu nazwanego
(defun jk:ENT_Name-p (Tbl Name)
  (if
    (not (tblobjname Tbl Name))
    (if
      (snvalid Name 0)
      0  ; nie ma
      -1 ; zla nazwa
    )
    1    ; juz jest
  )
)
(defun Make-or-ChangeTextStyle (Name ListProp / ch vo)
  (setq ch (jk:ENT_Name-p "STYLE" Name))
  (if
    (setq vo
      (cond
        ( (zerop ch)
          (vla-add (vla-get-textstyles (cd:ACX_ADoc)) Name)
        )
        ( (= 1 ch)
          (vla-item (vla-get-textstyles (cd:ACX_ADoc)) Name)
        )
        (T nil)
      )
    )
    (cd:ACX_SetProp vo ListProp)
  )
  vo
)
;(Make-or-ChangeTextStyle "IS_SIMPLEX" '(("fontfile" . "simplex.shx")("Height" . 5.0)))

Kod: Zaznacz cały
(defun cd:SYS_GetFonts (/ lt reg ttfs ls shxs)
  (setq lt
    (vl-remove-if-not
      (function
        (lambda (%)(wcmatch % "*TrueType)"))
      )
      (vl-registry-descendents
        (setq reg
          (strcat "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
                  "Windows NT\\CurrentVersion\\Fonts"
          )
        ) ""
      )
    )
  )
  (setq ttfs
    (mapcar
      (function
        (lambda (%)
          (cons
            (vl-string-right-trim " (TrueType)" %)
            (vl-registry-read reg %)
          )
        )
      )
      (vl-remove-if-not
        (function
          (lambda (%1 / %2)
            (and
              (not
                (wcmatch
                  (setq %2 (vl-registry-read reg %1))
                  "*\\*"
                )
              )
              (wcmatch (strcase %2) "*.TTF")
            )
          )
        ) lt
      )
    )
        lt (mapcar (quote car) ttfs)
        ls (vl-directory-files
             (vl-filename-directory
               (findfile "isocp.shx")
             )
             "*.shx"
           )
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )
  (list
    (append lt ls)
    (append ttfs shxs)
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 678
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kruuger » kwi 03, 2017 10:18

CAD_Pack zaktualizowany o ACX_AddViewport i USR_GetCorner.
mozecie jeszcze sprawdzic. help wkrotce.
Avatar użytkownika
kruuger
 
Posty: 4823
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

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

Postprzez ziele_o2k » sty 31, 2018 12:53

Tak się zastanawiam, czy nie dodać do cd:ACX_AddTable opcji dostosowywania do UCS (T/nil) wzorem innych funkcji?
Jest z tym niestety pewien problem, ponieważ
Kod: Zaznacz cały
(vlax-put table 'direction (trans '(1 0 0) 1 0 T))
nie do końca działa. Tabela nie chce się zaktualizować po wstawieniu - dopiero po rozpoczęciu edycji tabeli (wypełniania komórek, ustawiania szerokości kolumn itd.).
Ja to obszedłem w swoich lispach za pomocą:
Kod: Zaznacz cały
;;------------------=={ Rotate by Matrix }==------------------;;
;;                                                            ;;
;;  Rotates a VLA-Object or Point List using a                ;;
;;  Transformation Matrix                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  target - VLA-Object or Point List to transform            ;;
;;  p1     - Base Point for Rotation Transformation           ;;
;;  ang    - Angle through which to rotate object             ;;
;;------------------------------------------------------------;;

(defun LM:RotateByMatrix ( target p1 ang )
 
  (LM:ApplyMatrixTransformation target
    (setq m
      (list
        (list (cos ang) (- (sin ang)) 0.)
        (list (sin ang)    (cos ang)  0.)
        (list    0.           0.      1.)
      )
    )
    (mapcar '- p1 (mxv m p1))
  )
)

ze strony http://www.lee-mac.com/matrixtransformationfunctions.html ale wydaje mi się, że można zgrabniej to wykonać. Niestety nie wiem jak. Na Cadtutor podpowiedzieli coś takiego, ale też mi się nie podoba:
Kod: Zaznacz cały
(setq table
  (vla-AddTable
     Space
     (vlax-3d-point 0.0 0.0 0.0)
     Rows
     Cols
     RowH
     ColH
  )
)

(vlax-put table 'direction (trans '(1 0 0) 1 0 T))
(vla-move table (vlax-3d-point 0.0 0.0 0.0) (vlax-3d-point (trans Pb 1 0)))


No i oddzielna sprawa, czy dodać tworzenie stylu tabeli?
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 678
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kojacek » sty 31, 2018 18:32

Ja myślę że pan kierownik kruuger musi się zająć jakąś aktualizacją Pack'a...
Avatar użytkownika
kojacek
 
Posty: 5428
Dołączył(a): paź 03, 2005 20:17

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

Postprzez kruuger » sty 31, 2018 23:30

kojacek napisał(a):Ja myślę że pan kierownik kruuger musi się zająć jakąś aktualizacją Pack'a...

wrzucac tutaj co tam chcecie. potestujemy i dodamy :)
no faktycznie troche kupka z ta tabelka w ucs.
k.
Avatar użytkownika
kruuger
 
Posty: 4823
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

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

Postprzez ziele_o2k » mar 07, 2018 11:13

Czemu coś takiego nie trafiło do cadpacka:
Kod: Zaznacz cały
; ============================================================ ;
; Attach Xref                                                  ;
;   Path   [STR] - xref full path                              ;
;   File   [STR] - xref file name                              ;
;   InPt  [LIST] - xref insertion point (3D point)             ;
;   X     [REAL] - X scale factor                              ;
;   Y     [REAL] - Y scale factor                              ;
;   Z     [REAL] - Z scale factor                              ;
;   Rot   [REAL/nil] - angle of rotation in radians            ;
;   Ovlay [BOOL] - reference type:                             ;
;                  nil = attachment                            ;
;                  T   = overlay                               ;
; ------------------------------------------------------------ ;
; (kr:BLK_AttachXref "C:\\CAD" "Cad" '(5 5 5) 10 10 10 0.75 T) ;
; ============================================================ ;
(defun kr:BLK_AttachXref (Path File InPt X Y Z Rot Ovlay / zdir xang)
   (setq   
      zdir (trans '(0 0 1) 1 0 T)
      xang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 zdir))
   )
  (vl-catch-all-apply
   'vla-AttachExternalReference
    (list
      (vla-get-modelspace
        (vla-get-activedocument
          (vlax-get-acad-object)
        )
      )
      (strcat (vl-string-right-trim "\\" Path) "\\" File) File
      (vlax-3d-point InPt)
      X Y Z (if (not Rot) 0.0 (+ Rot xang))
      (if Ovlay
        :vlax-true
        :vlax-false
      )
    )
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 678
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez kruuger » mar 08, 2018 08:32

ziele_o2k napisał(a):Czemu coś takiego nie trafiło do cadpacka:
Kod: Zaznacz cały
; ============================================================ ;
; Attach Xref                                                  ;
;   Path   [STR] - xref full path                              ;
;   File   [STR] - xref file name                              ;
;   InPt  [LIST] - xref insertion point (3D point)             ;
;   X     [REAL] - X scale factor                              ;
;   Y     [REAL] - Y scale factor                              ;
;   Z     [REAL] - Z scale factor                              ;
;   Rot   [REAL/nil] - angle of rotation in radians            ;
;   Ovlay [BOOL] - reference type:                             ;
;                  nil = attachment                            ;
;                  T   = overlay                               ;
; ------------------------------------------------------------ ;
; (kr:BLK_AttachXref "C:\\CAD" "Cad" '(5 5 5) 10 10 10 0.75 T) ;
; ============================================================ ;
(defun kr:BLK_AttachXref (Path File InPt X Y Z Rot Ovlay / zdir xang)
   (setq   
      zdir (trans '(0 0 1) 1 0 T)
      xang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 zdir))
   )
  (vl-catch-all-apply
   'vla-AttachExternalReference
    (list
      (vla-get-modelspace
        (vla-get-activedocument
          (vlax-get-acad-object)
        )
      )
      (strcat (vl-string-right-trim "\\" Path) "\\" File) File
      (vlax-3d-point InPt)
      X Y Z (if (not Rot) 0.0 (+ Rot xang))
      (if Ovlay
        :vlax-true
        :vlax-false
      )
    )
  )
)

korzystales cos wiecej, dziala wszystko? mozna dodac
Avatar użytkownika
kruuger
 
Posty: 4823
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

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

Postprzez ziele_o2k » mar 08, 2018 11:34

kruuger napisał(a):korzystales cos wiecej, dziala wszystko? mozna dodac

Mam dwa lispy, które jadą na tym kodzie i śmiga całkiem ładnie.
Swoją drogą to jest zmieniona wersja Twojego lispa wykopanego na forum. Tutaj wersja poprawiona i dostosowana do cadpacka:
Kod: Zaznacz cały
; =========================================================================================== ;
; Wstawia zewnętrzny odnośnik / Attach Xref                                                   ;
;  Path  [STR]      - pełna ścieżka do pliku xref / xref full path                            ;
;  File  [STR]      - nazwa pliku odnośnika / xref file name                                  ;
;  Pb    [LIST]     - punkt wstawienia / insertion point                                      ;
;  Xyz   [LIST/nil] - LISTA = lista wspolczynnikow skali XYZ / list of X Y Z scale factor     ;
;                     nil   = X=Y=Z=1.0                                                       ;
;  Rot   [REAL/nil] - REAL = kat obrotu w radianach / rotation angle in radians               ;
;                     nil  = kat=0.0 / angle=0.0                                              ;
;  Ovlay [BOOL]     - typ odnośnika / reference type:                                         ;
;                     nil = dołącz / attachment                                               ;
;                     T   = nałóż / overlay                                                   ;
; ------------------------------------------------------------------------------------------- ;
; (cd:BLK_AttachXref "C:\\CAD" "Cad" '(5 5 5) '(10 10 10) 0.75 T)                             ;
; (cd:BLK_AttachXref "C:\\CAD\\" "Cad" '(5 5 5) '(10 10 10) 0.75 T)                           ;
; =========================================================================================== ;
(defun cd:BLK_AttachXref (Path File Pb Xyz Rot Ovlay / zdir xang res)
  (setq   
    zdir (trans '(0 0 1) 1 0 T)
    xang (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 zdir))
  )
  (if
    (not
      (vl-catch-all-error-p
        (setq res
          (vl-catch-all-apply
            (quote vla-AttachExternalReference)
            (list
              (cd:ACX_ASpace)
              (strcat (vl-string-right-trim "\\" Path) "\\" File)
              File
              (vlax-3d-point Pb)
              (if (not Xyz) 1.0 (car Xyz))
              (if (not Xyz) 1.0 (cadr Xyz))
              (if (not Xyz) 1.0 (caddr Xyz))
              (if (not Rot) 0.0 (+ Rot xang))
              (if Ovlay
                :vlax-true
                :vlax-false
              )
            )
          )
        )
      )
    )
    res
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 678
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