_

[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 kojacek » kwi 10, 2018 17:33

kruuger napisał(a):cos z dokladnoscia chyba nie gra?
Kod: Zaznacz cały
Command: (cd:CON_rtd 34.332 nil)
1967.08

Command: (cd:CON_rtd 34.332 t)
167.0


Zrobiłem tak:
Kod: Zaznacz cały
(defun cd:CON_RtD (a Mode / d r)
  (defun d (a)(* pi (/ a 180.0)))
  (defun r (a)(* 180.0 (/ a pi)))
  (if Mode
    (if
      (>= a (* 2 pi))
      (r (angtof (angtos (d (r a)) 0 16)))
      (r a)
    )
    (r a)
  )
)

Precyzja ustawiona jest na 16 miejsc po przecinku. I teraz sprawdzam:
Kod: Zaznacz cały
(list
  (cd:CON_Real2Str (cd:CON_rtd 34.332 nil) 2 10)
  (cd:CON_Real2Str (cd:CON_rtd 34.332 t) 2 10)
)

zwraca:
Kod: Zaznacz cały
("1967.0787022431" "167.0787022431")

dla samych liczb:
Kod: Zaznacz cały
(list
  (cd:CON_rtd 34.332 nil)
  (cd:CON_rtd 34.332 t)
)

zwraca:
Kod: Zaznacz cały
(1967.08 167.079)
Avatar użytkownika
kojacek
 
Posty: 5450
Dołączył(a): paź 03, 2005 20:17

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

Postprzez Ania Kowal » kwi 27, 2018 10:10

Witam,

Czy idzie to odpalić na AutoCADzie 2010 LT?
Jak to zrobić?

A może na (darmowym) DraftSight da się?

Pozdrawiam
Ania Kowal
 
Posty: 3
Dołączył(a): kwi 27, 2018 10:07

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

Postprzez kojacek » kwi 27, 2018 10:43

Ania Kowal napisał(a):Witam,

Czy idzie to odpalić na AutoCADzie 2010 LT?
Jak to zrobić?

A może na (darmowym) DraftSight da się?

Pozdrawiam


Niestety nie. To działa tylko na pełnym AutoCAD-zie (w 100%), oraz w ograniczonym zakresie (< 100%), na klonach AutoCAD-a, obsługujących AutoLISP / VisualLISP, czyli: BricsCAD / IntelliCAD / ZwCAD / GStarCAD... i pewnie paru innych.
Avatar użytkownika
kojacek
 
Posty: 5450
Dołączył(a): paź 03, 2005 20:17

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

Postprzez Ania Kowal » kwi 27, 2018 11:08

kojacek napisał(a):
Ania Kowal napisał(a):Witam,

Czy idzie to odpalić na AutoCADzie 2010 LT?
Jak to zrobić?

A może na (darmowym) DraftSight da się?

Pozdrawiam


Niestety nie. To działa tylko na pełnym AutoCAD-zie (w 100%), oraz w ograniczonym zakresie (< 100%), na klonach AutoCAD-a, obsługujących AutoLISP / VisualLISP, czyli: BricsCAD / IntelliCAD / ZwCAD / GStarCAD... i pewnie paru innych.


A czy ktoś napisał (w miarę) darmową nakładkę?
Bo po pobieżnym przeszukaniu internetu to takie nakładeczki się pojawiają, ale brakuje mi rozeznania.

A czy istniej jakieś makro, które by mi środkowało zaznaczone elementy (poza lipsowymi rozwiązaniami) względem obranego prostokąta?

Przydałaby mi się taka opcja jak np. w Wordzie jest z rozmieszczeniem danych w komórce.
Ania Kowal
 
Posty: 3
Dołączył(a): kwi 27, 2018 10:07

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

Postprzez ziele_o2k » wrz 06, 2018 20:04

Prośba o drobną zmianę w cd:SYS_GetFonts:
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 "txt.shx")
             )
             "*.shx"
           )
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )
  (list
    (append lt ls)
    (append ttfs shxs)
  )
)

zmieniłem (findfile "isocp.shx") na (findfile "txt.shx"), ponieważ pochodne cada nie mają isocp :)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 728
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

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

Postprzez ziele_o2k » wrz 06, 2018 21:30

albo może coś takiego:
Kod: Zaznacz cały
(defun cd:SYS_GetFonts (/ lt reg ttfs ls shxs res tmp)
  (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"
          )
        ) ""
      )
    )
  )
    (foreach % (cd:STR_Parse (getenv "ACAD") ";" T)
        (cond
            (   (and
                    (setq tmp (vl-directory-files % "*.shx"))
                    res
                )
                (setq res (append tmp res))
            )
            (   tmp
                (setq res tmp)
            )
            (   t nil )
        )
    )
  (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 res
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )

  (list
    (append lt ls)
    (append ttfs shxs)
  )
)

EDIT:
Poprawiona wersja:
Kod: Zaznacz cały
(defun cd:SYS_GetFonts (/ _Unique lt reg ttfs ls shxs res tmp)
    (defun _Unique ( l )
        (if l (cons (car l) (_Unique (vl-remove (car l) (cdr l)))))
    )
  (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"
          )
        ) ""
      )
    )
  )
    (foreach % (cd:STR_Parse (getenv "ACAD") ";" T)
        (cond
            (   (and
                    (setq tmp (vl-directory-files % "*.shx"))
                    res
                )
                (setq res (append tmp res))
            )
            (   tmp
                (setq res tmp)
            )
            (   t nil )
        )
    )
    (setq res (_Unique res))
   
  (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 res
        shxs (mapcar (function (lambda (%)(cons % %))) ls)
  )

  (list
    (append lt ls)
    (append ttfs shxs)
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 728
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Poprzednia strona

Powrót do AutoCAD

Kto przegląda forum

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