Пятница, 29.03.2024, 15:38
Приветствую Вас Гость | RSS

 
 

Анти случайный математический сайт: всё Бесплатно 18+ kenokeno.ucoz.ru

Anti chaotically math site all FREE against losses против проигрышей 18+

 
Карта мира Пирамида Жизни Визуальная математика Всеобуч CoronaVirus

карта статистики посетителей & исследования и конкурсы бесплатные & ВКонтакте & Математический Блог & КеноКено & КЕНО ЮТЮБ KENO mini YOUTUBE

БЕЗ рекламы БЕЗ партнёрских БЕЗ рефералов NO advertising NO partners NO referrals pas de publicite pas de partenaires pas de references

Ссылки внутри страниц открываются в новой вкладке Links inside pages open in a new tab of browser

КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE КЕНО ЮТЮБ KENO mini YOUTUBE

Просвещение России содержит гигантский пробел:
интегралы в любом виде в младшей школе не изучаются

даже словами отличными от слова "интеграл": "сбор"
в то время как интеграл в жизни ежесекундно: и одежда
и продукты и выбор в магазине и транспортная задача

ведь понимая интегральную суть человек сравнивает
без расчётов в уме и делает оптимальный выбор

ключевые 27

свои чужие другие
актив пассив экономия
лидер ведомый жертва
жизнь машина язык
цель время контроль
услуга товар качество
экспорт эксплуатация технология
интеграл логарифм производная
элита антиэлита приоритет

 

keywords 27

ours aliens others
active passive saving
leader slave victim
life machine language
target time control
service goods quality
export exploitation technology
integral logarithm derivative
elite antielite priority

 

 

Россия видит мир из будущего

Russia looks world from future

Rossiya vidit mir iz buduschego

IQ бесплатно Яндекс.Метрика

всегда пишу только про себя и никогда никому ничего не рекомендую

i always write only about myself and anything to anyone never recommend

мен әрқашан тек өзіме жазамын және ешқашан ешкімге ештеңе ұсынбаймын

завжди пишу тільки про себе і ніколи нікому нічого не рекомендую

web.archive.org/web/20230602154543///kenokeno.ucoz.ru/publ/

ich schreibe immer nur über mich selbst und empfehle niemandem etwas

j'écris toujours seulement sur moi-même et je ne recommande

mi ĉiam skribas nur pri mi mem kaj neniam rekomendas ion al iu

siempre escribo solo para mí y nunca recomiendo nada a nadie

web.archive.org/web/20230602152617///kenokeno.ucoz.ru/load/

 

Главная | Регистрация | Вход

 
Главная » 2014 » Май » 11 » AutoCAD LISP 77
08:29
AutoCAD LISP 77

AutoCAD LISP 77

 

zz.lsp = обнуление координаты Z

 

;; ZeroZets. Free утилита для ZWCAD. Stol@2009(-11)
(setq zz_help_string (strcat
"    Утюг для Z (или ZeroZet)\n\n"
" Обнуляю координаты Z (в том числе, возвышения и выдавливания !)\n"
" Или глажу \"колючки\" на чертеже, который должен быть плоским.\n"
" \"Скрипит\" мой \"скрипт\" медленно, но дотошно.\n\n"
" ТелА и поверхности (ввиду их \"мистического\" описания) не трогаю !\n\n"
" Enter (правый клик мыши) здесь - НЕ отказ от выбора,\n"
" а приказ выбрать всё: _ALL, в т.ч. и определения блоков!\n"
" (чего уж проще: набрал ZZ - и трижды [Enter]).\n\n"
" Для определённости Систему Координат переключаю в Мировую!\n\n"
" \"Бегущая строка\" текущего результата :\n"
"    ZZ: тчк: ( npc [- npcn] ) / npall Время {об: nss} \n"
"   где :    npc ненулевых Z-координат обнулил,\n"
"    а npcn чисел не смог изменить\n"
"    из всех npall просмотренных дескрипторов,\n"
"    которые могли бы содержать Z-координату,\n"
"    Время = До конца: чч:мм:сс - оценка времени,\n"
"    для проверки оставшихся ещё nss объектов.\n"
"    Если npcn=0, то [-npcn] опускается.\n\n"
" В строке Результата пишу ещё к-во проверенных блоков (если nb>0),\n"
" разброс по координате Z и затраченное на проверку время:\n"
"    ZZ:тчк:(npc [-npcn])/ npall {об:nss0 [блк:nb] } Zmin Zmax Время\n"
"   где :    было выбрано nss0 объектов (+ с учётом под-объектов)\n"
"    плюс nb блоков (записей в таблице блоков)\n"
"    Время= Длилось: чч:мм:сс - всего затрачено на работу.\n"
" При ошибке(отмене), в конце результата - краткое сообщение системы\n\n"
" В файле C:\\ZZ.log накапливаются строки результатов глажки в виде:\n"
"         Дата   Имя.dwg   Результат.\n\n"
"        Здоровья вам и удачи в MMXII году !\n"    ;; = 2012
));strcat zz_help

;; PSs.
;; 1.Cейчас, вроде, ОК, но в версиях до 2009i слово "_ALL" выбирало не полностью всё.
;; 2.По идее, замкнутые слои недоступны для изменений. В Автокаде - да, но, похоже,
;;    в этом Зюкаде замок - не преграда для обнуления! Не плохо. Но Странно.   :)
;; 3.Примечание: текст данного лиспа выровнен по: Tab=8, Arial-15-обыч.
;; 4.Фраза "n'of" = "number of someones" (к-во чего-то)
;; 5."Стишутка" выпадает только при отмене задания, если npc>100.

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun C:ZZ ( /     ss nss nss0 en ent FF nz npc npcn npall jmp npl pt dt0 dt0d
            blkpt x y z zmin zmax str cmde olderr nb title a0 msg estim)
;; _ v a r i a b l e s _ :
;; ss nss nss0:        selection-set & n'of-elements-in-ss
;; nb:                n'of Block-records inspected
;; en ent:            entity-pointer & entity-list
;; FF:             flag-of-ALL-selection ("Full-0-Flag")
;; nz npc npcn npall:    n'of [non-]success changes of points
;; x y:            unchanged coords x&y
;; z zmin zmax:         calculated Z (coordinates, elevations, etc.)
;; str st snb snpc title:strings of result (+ joke-message)
;; a0:            entity-name (assoc 0 ...)
;; dt0 dt0d:        base time to calculate time-interval
;; cmde:             save "CmdEcho" value
;; msg:             error message from system or ":ZZ" from me
;; estim:            estimating time(string) for zero-process

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun DOMOD ( / n38 a38 n10 n710 pt pt10)    ;;== DO MODification ==;;
  (setq nz 0)                        ;; nz = accum-ed n'of non-zero-Z-points in 1 entity
  (if (equal (assoc 210 ent) '(210 0.0 0.0 1.0)) ;; extrusion-direction must be XY-orthogonal
     (progn
    (foreach n38 '(38 39)                ;; n38 is (38 . Elevation) or (39 . Thickness)
      (setq a38 (assoc n38 ent))
      (if a38    (progn
        (setq z (cdr a38)
          zmin (min zmin z)
          zmax (max zmax z)
          npall (1+ npall)
        )
        (if (/= z 0.0)                ;; kill Elevation / Thickness
          (setq ent (subst (cons n38 0.0) a38 ent) nz (1+ nz) )
        )    );progn
      );if-a38
    );foreach-n38
 ));if z-ortho
 ;;(setq n10 10)                        ;; point descriptor can have mark from 10 to 18
  (foreach n10 '(10 11 12 13 14 15 16 17 18);; or == (repeat 9 ..:) ==
    (setq pt10 (assoc n10 ent)            ;; get (<n10> x y [z])
        n710 (+ n10 700)            ;; 710-718 = reserve DXF-marks for replacing
    );setq
    (while pt10                    ;; loop while points exist
        (setq pt (cdr pt10)            ;; (x y [z]) = current point
            npall (1+ npall)            ;; npall = tot.n'of 3D-"points" processed in all entities.
            npl (1- npl)            ;; npl is the count, decreases from jmp to 0
        );pt
        (if (<= npl 0) (progn            ;; = step for prompt result every jmp points.
            (setq npl jmp)            ;; anew npl
            (setq estim (strcat " _ До конца: " (DATI 1) ) )
            (prompt (STRES nil))
                   );progn
        );if step
        (setq     z (nth 2 pt)        ;; be careful!    Z may absent! (= nil)
        );setq-pt                    ;; Z is extracted for testing
        (if (AND z (/= z 0.0))            ;; if non-zero Z then construct new point
            (setq nz (1+ nz)            ;; to replace current non-zero-Z-value with 0
             zmin (min zmin z)        ;; store max & min Z
             zmax (max zmax z)
             x (nth 0 pt)            ;; x
             y (nth 1 pt)            ;; y
             pt (list x y 0.0)            ;; (x y 0.0) = new pt with Z=0
            );
        );if Z /= 0
        (setq ent (subst (cons n710 pt) pt10 ent)    ;; substitute for searching forward
            pt10 (assoc n10 ent)        ;; (nn x y z) next sublist
        );
    );while pt10 (clockwize-end-of-loop)

    ;; *** and now - recover all pt10 -descriptor-marks (Marx?:) ***
    (setq     pt10 (assoc n710 ent) )     ;; (7nn x y [z])
    (while pt10
        (setq    pt (cons n10 (cdr pt10))    ;; (nn x y [z])
            ent (subst pt pt10 ent)    ;; replace n710 <-- n10
            pt10 (assoc n710 ent)    ;; (7nn x y [z]) next sublist
        )
    );while pt (counter-clock-end-of-loop)
    ;;(setq n10 (1+ n10))
  );foreach [repeat] n10

    (if (> nz 0) (progn                ;; if points should be changed, then try entity modify
        (if (entmod ent)
         (setq npc (+ nz npc)            ;; n'of microchanges at all
         ); if-entmod-success
         (progn                    ;; else print-out unsuccess entity (expt.viewport) for analyze
          (setq    npcn (+ nz npcn)    ;; proceed n'of not-changed non-zero points
          );setq
          (print (strcat "Ош.объект=" (cdr (assoc 5 ent)))) (print en)
            (if (equal a0 "VIEWPORT") (print (strcat "_____ " a0)) (print ent) )
          (prin1)
         );progn UNsuccess
        );if entmod
    ));if-change (non-zero Z-s)
);DOMOD

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun DATI (DTF / sd dt hh mm ss)        ;; flag: date-OR-time
 (if DTF
    (progn                        ;; get time
    (setq sd (getvar "date"))            ;; current n'of days (from 1.1.4713 B.C.E.)
    (if (= DTF 0.0)    (setq dt0 sd)        ;; if DTFlag=0, then store current dat'ime (init dt0)
        (progn                    ;; else make string of time estimated for ZZ-process
        (setq dt (- sd dt0)            ;; on base of delta-time & n'of objects processed
          sd (* dt (/ (float nss) (float (- nss0 nss))) )    ;; Time estimated in days (float)
          sd (* 24.0 sd)                ;; hours = days * 24
          hh (fix sd)                ;; n'of hours (integer->string)
          sd (* 60.0 (- sd hh))            ;; rest of hours * 60 = minutes
          mm (fix sd)                ;; n'of minutes (integer)
          sd (* 60.0 (- sd mm))        ;; rest of minutes * 60 = seconds
          ss (fix sd)                ;; n'of seconds (integer)
          sd (strcat (itoa hh) ":" (itoa mm) ":" (itoa ss))
        ));progn
    );if DTF=0
    );progn-time
    (progn                        ;; else - get date and prepare
    (setq cdat (getvar "cdate")            ;; date-string for put it into log-file
        sd (fix cdat)
        sd (itoa sd)                ;; date = YYYYMMDD
        sd    (strcat
            (substr sd 1 4) "-"
            (substr sd 5 2) "-"
            (substr sd 7 2) " "
        );                        ;; date = [YYYY-MM-DD] =
    );setq sd
     );progn-date                    ;; return date-result
 );if DTF
);dati
 
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun DOSS ( )                    ;; ________sub-main-sub:_do-selected-set________
     (setq ent (entget en)                ;; get entity from selection-set OR from block-record
       a0 (cdr (assoc 0 ent))            ;; entity-name
       f66 (equal (assoc 66 ent) '(66 . 1))    ;; when Block OR complex-entity (for ex., 3D-polyline)
     )
     (DOMOD)
     (while f66
        (setq en (entnext en) ent (entget en)
        nss1 (1+ nss1)                ;; increase n'of simple entities selected
        f66 (not (assoc -2 ent))
     );
    (if f66 (DOMOD) )
     );while-f66
);doss

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun FERR (msg / fil)             ;; exception handling & result-printing function
  ;; if arg.msg=":ZZ", then use this func. to put result to screen, command-bar, file 
  ;; result-string:        (STRES)    or    " Нету Z=/=0 "
 
  (if (> npc 0) (progn
  (setq str (STRES T)                    ;; string for output
    z_min (rtos zmin 1 1)
    zmix (if (= zmin zmax)                ;; [zmix = zmin = zmax]
         (strcat " Zmin=Zmax=" z_min)
         (strcat " Zmin=" z_min " Zmax=" (rtos zmax 1 1) )
        );zmix
    dt0 dt0d nss0 2 nss 1            ;; numbers for calculation duration
    estim (strcat " Длилось: " (DATI 1) )
    title    (strcat str zmix " " msg estim)
  );setq

  (prompt str)

  (setq fil (open "C:/ZZ.log" "a"))
  (write-line (strcat (DATI nil) (getvar "dwgname") title) fil)
  (close fil)
 
  (If (/= msg ":ZZ")
    (progn
    (setq *error* olderr)                ;; restore original func.
    (prompt (strcat "\r ZZ: ОШ:" msg "!.."))
    (if (AND FF (> npc 100))
        (setq title    (strcat
        " Скобки, скобки, в глазах уж рябит,\n"
        " Окружили,   как   стая   гадюк.\n"
        " Голова   от   напряга   горит.\n"
        " Не послать ли программу... на \"Юх\"?\n\n"
        " Ну, не Пушкин.  Но - в рифму и ритм.\n"
        " Написал   инструмент.    Не  матюг...\n"
        " Наслаждайтесь!..  А   мой   алгоритм\n"
        " Вам   прогладит  чертёж.   Как УТЮГ.\n\n"
        str    "\n\n"
        zmix "\n\n"
        estim
        "\n\n        (:° °:)"
        "\n          \\   /"
        "\n           \\ /"
        "\n            v  "
        ));strcat-setq
    );if
    );e-progn-err
  );e-if
  (alert title)
  );progn if npc>0
  (progn                            ;; else no nzz
    (setq str " Нету Z=/=0 ")            ;; string for output
    (alert str)
 )); if npc>0
(print "ZZ:       К О Н Е Ц       ")
);e-ferr

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun RT(a)  (rtos a 2 0)  );rt-fun        ;; auxiliary func.

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  ;; 
(defun STRES (Fin / st snpcn snb)        ;; returns string of result:
   (setq                            ;; current / final(Fin=T)
    snpcn (if (> npcn 0) (strcat "-" (RT npcn) ) "")
    st (strcat " ZZ: тчк:(" (RT npc) snpcn ")/" (RT npall) )
   );
   (if Fin                             ;; Fin=T returns final string
    (setq   
        snb (if (> nb 0) (strcat "[блк:" (RT nb)"]") "")
        st (strcat st " об:" (RT nss0) snb " ")
    );
    (strcat "\r" st estim " {об:" (RT nss) "}     " )    ;; else current result
   );result-string
);stres

;; - - - - - - - - - - - - - - - - - - - - - - - - S - T - A - R - T - - - - - - - - - - - - - - - - - - - - - - - ;; 
(setq olderr *error* )                    ;; save original exception handling function
(setq *error* ferr)

(setq title   
    (strcat
    " * * *  УТЮГ  * * *\n\n"
    " выбор объектов:\n\n"
    "[Esc] = Отказ.\n\n"
    " ALL = все объекты,\n"
    "    но БЕЗ блоков,\n\n"
    "[Enter] или прав.мышь\n"
    "  = ALL + все Блоки.\n\n"
    "[?] = доп.справка.\n\n"
    "            ^v^"
)    );setit
(alert title)

(setq npc 0 npcn 0 nb 0                 ;; initial zeros,
    jmp 500                        ;; prompt every n-jump'th time while processing points                        
    npl jmp                        ;; [ jmp may vary for custom comfort ]
    npall 0                        ;; npall = n'of inspected points
);setq init

(setq str (getstring "\r ? / [Enter]") )
(if (= str "?") (alert ZZ_help_string) )

(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_UCS" "_W")                ;; go to WORLD coord.system
(setq ss (ssget) zmin 0 zmax 0 FF nil        ;; if empty (Enter/Right-click) then select All (FULL Zero),
    dt0d (getvar "date")                ;; save initial date-time for duration calculation
);
(if (not ss) (setq ss (ssget "X") FF T))        ;; FF (Flag if Full Zero ordered = whole dwg selected)
(if (not ss) (exit))                    ;; exit from empty drawing (in rare case)
(setq nss (sslength ss) nss0 nss
    nss1 0                         ;; added n'of simple entities in process
    estim "_pls,wait"
)
(prompt "\n ZZ: подсчёт объектов, подождите, пжлста _ _ _ \n")
(DATI 0.0)                            ;; init time (DT0)
(while (> nss 0)
  (setq nss (1- nss) en (ssname ss nss) )
  (DOSS)                            ;; main LOOP
);while-nss
(prompt (strcat "\r" (STRES T) " _ _ _ ") )

(if FF (progn                        ;; if Full Zero, then loop on Block records, too
  (prompt "\n ZZ: подсчёт блоков, подождите, пжлста _ _ _ \n")
  (setq nss1 (+ nss1 nss0)                ;; init. before blocks-test
    blkpt (tblnext "BLOCK" T)            ;; 1st block
    npl jmp                        ;; again init jmp ~500 (100 ?)
  );
  (while blkpt
    (setq a2 (assoc -2 blkpt)             ;; to know total n'of blks
        nb (1+ nb)                    ;; count 'em (nb)
        blkpt (tblnext "BLOCK")        ;; each next block in table
    );
   );while blocks

  (setq nss nb nss0 nb
    blkpt (tblnext "BLOCK" T)            ;; again to start of blk-table
  )
  (DATI 0.0)                        ;; init time (DT0) for Blocks
  (while blkpt
    (setq a2 (assoc -2 blkpt)             ;; to know total n'of blks (nb)
        en (cdr a2)
        nss (1- nss)                ;; count nss - for current info
    );
    (while en
        (DOSS)                    ;; second LOOP (in block-record)
        (setq en (entnext en)            ;; to see every entity within block
            nss1 (1+ nss1)            ;;+increase tot.n'of objects count
        )
    );while en
    (setq blkpt (tblnext "BLOCK")    )    ;; each next block in table
  );while blocks
  (setq nss0 (+ nss0 nss1) )
));if FF

(command "_regen")
(FERR ":ZZ")                        ;; print results
(setvar "cmdecho" cmde)
(princ)
);; -the-end-of-ZeZet-

 


zz.lsp = обнуление координаты Z

 

Просмотров: 371 | Добавил: DANILIN | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email *:
Код *:

Форма входа

Поиск

Календарь

Статистика


Онлайн всего: 1
Гостей: 1
Пользователей: 0
Карта мира

Данный сайт средством массовой информации не является.
Данный сайт: личный дневник, созданный в развлекательных целях.
Данный сайт азартные игры не пропагандирует и не организует.
Данный сайт ставки не принимает и выигрыши не выплачивает.
Данный сайт никакие платные услуги не предоставляет.

Сайт и автор за упущенную выгоду ответственность не несёт.
Сайт и автор за возможные убытки ответственность не несёт.

Файлы имеют цель: приоритет открытий, изобретений, формул и творчества
и тексты выражают субъективные оценочные суждения без упоминания имён.

Все тексты юридической силы не имеют и служить доказательством в суде не могут.
Все формулы возможно вывести самостоятельно и ответ автора сайта не нужен.
18+ web.archive.org/web/20230602152617///kenokeno.ucoz.ru/load/?page2

This site is not a media outlet.
This site: personal diary created for entertainment purposes.
This site promote does not and gambling not organize.
This site bets does not accept and winnings does not pay out.
This site any paid does services not provide.

Site and author for lost profits are not responsible.
Site and author for possible losses are not responsible.

Files have a target: priority of discoveries, inventions, formulas, and creativity
and texts express subjective value judgments without mentioning any names.

All texts have no legal force and as evidence in court cannot serve.
All formulas can be deduced independently & response of site author is not required.
18+ web.archive.org/web/20230602154543///kenokeno.ucoz.ru/publ/?page2

Бесплатный конструктор сайтов - uCozЯндекс.Метрика