AutoCAD LISP 55

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

;;;Обнуление координаты Z

(defun c:Z0 (/ ss *error* lst tmp j bl e1)
  (vl-load-com)
 (defun *error* (message / image_set)
        (while (> (getvar "CMDACTIVE") 0) (command))
        (or *kpblc-activedoc*
            (setq *kpblc-activedoc*
                   (vla-get-activedocument (vlax-get-acad-object))
            ) ;_ end of setq
        ) ;_ end of or
        (princ message)
        (foreach item *kpblc-list-layer-status*
          (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
        ) ;_ end of foreach
        (setq *kpblc-list-layer-status* nil)
        (kpblc-error-restore-sysvar)
        (vla-endundomark *kpblc-activedoc*)
        (princ)
      )
  (or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
      )
  (kpblc-error-save-sysvar
    (list
      '("osmode")
      '("CLAYER")
      '("DIMZIN")
      '("QACountS" 0)
      '("CMDECHO" 0)
      '("EXPERT" 5)
      '("highlight" 1)
      '("cecolor" "bylayer")
      '("CELTYPE" "bylayer")
      '("limcheck" 0)
      '("pickstyle" 0)
      '("ANGBASE" 0)
      '("ANGDIR" 0)
      '("UCSFOLLOW" 0)
      '("LUNITS" 2)
      '("AUNITS" 1)
      (list "LUPREC" (max 2 (getvar "LUPREC")))
      (list "AUPREC" (max 3 (getvar "AUPREC")))
      (list "ucsicon" (getvar "ucsicon"))
    )
  )
  (vla-startundomark *kpblc-activedoc*)
  (mip:layer-status-save)
  (SETQ SS NIL)
  (princ "\nВыберите объеты или ENTER - весь чертеж")
  (if (null
    (setq SS (ssget '((-4 . "<NOT") (0 . "3DSOLID,OLE2FRAME") (-4 . "NOT>"))))
      )
    (progn
      (if (and (setq ss (ssget "_X" '((0 . "DIMENSION"))))
           (setq lst (lib:conv-pickset-to-list ss))
      )
    (progn
      (setq ss nil)
      (foreach item    lst
        (setq ss (entget item))
        (mapcar '(lambda (x)
               (if (setq tmp (assoc x ss))
             (setq ss (subst (list x (cadr tmp) (caddr tmp) 0.0)
                     tmp
                     ss
                  )
             )
               )
             )
            '(10 11 12 13 14) ;_Точки
        )
            (setq ss (entmod ss))
      )
    )
      )
      (setq SS (ssget "_X"
              (list
            '(-4 . "<NOT")
            '(0 . "3DSOLID,OLE2FRAME")
            '(-4 . "NOT>")
            (cons 410 (getvar "CTAB"))
              )
           )
      )
    )
  )
  (if SS
    (progn
      (setq j 0)
      (setq lst(lib:conv-pickset-to-list ss))
      (bg:progress-init "Обрабатываю: " (length lst))
      (foreach item lst
        (setq j (1+ j))
        (bg:progress j)
        ((lambda ( ed )
        (mapcar '(lambda (x)
               (if (setq tmp (assoc x ed))
             (if (numberp (cdr tmp))
              (setq ed (subst (cons x 0)
                     tmp
                     ed
                  )
                )
             
             (setq ed (subst (list x (cadr tmp) (caddr tmp) 0.0)
                     tmp
                     ed
                  )
             )
               )
               )
             )
            '(10 11 12 13 14 38 39)
        )
            (foreach z ed ;_spline
              (if (member (car z) '(10 11))
                (setq ed (subst (list (car z) (cadr z) (caddr z) 0.0)
                     z
                     ed
                  )
             )
                )
              )
        (entmod ed)
           )
          (entget item)
          )
        (if (and (= (cdr(assoc 0 (entget item))) "INSERT")
                 (= (cdr(assoc 66 (entget item))) 1)
                 )
          (while (and(setq item(entnext item))(/=(cdr(assoc 0(entget item))) "SEQEND"))
            ((lambda ( ed )
        (mapcar '(lambda (x)
               (if (setq tmp (assoc x ed))
             (if (numberp (cdr tmp))
              (setq ed (subst (cons x 0)
                     tmp
                     ed
                  )
                )
             
             (setq ed (subst (list x (cadr tmp) (caddr tmp) 0.0)
                     tmp
                     ed
                  )
             )
               )
               )
             )
            '(10 11 12 13 14 38 39)
        )
            (foreach z ed ;_spline
              (if (member (car z) '(10 11))
                (setq ed (subst (list (car z) (cadr z) (caddr z) 0.0)
                     z
                     ed
                  )
             )
                )
              )  
        (entmod ed)
           )
          (entget item)
          )
            )
          )
        )
       
      (bg:progress-clear)
      (princ (strcat "\n" (rtos j 2 0)  " Objects Flattened."))
    )
  )
(setq bl (tblnext "block" 1))
  (while bl
    (setq e1 (cdr(assoc -2 bl)))
    (while (and e1 (not (member '(0 . "ENDBLK") (entget e1))))
      ((lambda ( ed )
        (mapcar '(lambda (x)
               (if (setq tmp (assoc x ed))
             (if (numberp (cdr tmp))
              (setq ed (subst (cons x 0)
                     tmp
                     ed
                  )
                )
             
             (setq ed (subst (list x (cadr tmp) (caddr tmp) 0.0)
                     tmp
                     ed
                  )
             )
               )
               )
             )
            '(10 11 12 13 14 38 39)
        )
         (foreach z ed ;_spline
              (if (member (car z) '(10 11))
                (setq ed (subst (list (car z) (cadr z) (caddr z) 0.0)
                     z
                     ed
                  )
             )
                )
              )  
        (entmod ed)
           )
          (entget e1)
          )
      (setq e1 (entnext e1))
        )
    (setq bl (tblnext "block"))
      )
  (vla-endundomark *kpblc-activedoc*)
  (kpblc-error-restore-sysvar)
  (mip:layer-status-restore)
  (vl-cmdf "_.REGENALL")
  (princ)
)
  (defun mip:layer-status-restore ()
    (_kpblc-layer-status-restore)
    ) ;_ end of defun

  (defun mip:layer-status-save ()
      (_kpblc-layer-status-save nil)
    );_ end of defun

(defun bg:progress-init (msg maxlen)
  ;;; msg - сообщение или пустая строка
  ;;; maxlen - максимальное количество
  (or *BG:PROGRESS:OM* (setq *BG:PROGRESS:OM* (getvar "MODEMACRO")))
  (setq *BG:PROGRESS:MSG* (vl-princ-to-string msg))
  (setq *BG:PROGRESS:MAXLEN* maxlen)
  (setq *BG:PROGRESS:LPS* '-1)(princ)
  )
(defun bg:progress ( currvalue / persent str1 count)
  (if *BG:PROGRESS:MAXLEN*
    (progn
  (setq persent (fix (/ currvalue 0.01 *BG:PROGRESS:MAXLEN*)))
  ;;;Каждые 5 %
  (setq count (fix(* persent 0.2)))
  (setq str1 "")
  (if (/= count *BG:PROGRESS:LPS*)
    (progn
      ;;(setq str1 "")
      (repeat persent (setq str1 (strcat str1 "|")))
      )
    )
       ;;; currvalue - текущее значение
      (setvar "MODEMACRO"
              (strcat (vl-princ-to-string *BG:PROGRESS:MSG*)
                      " "
                      (itoa persent)
                      " % "
                      str1
                      )
              )
      (setq *BG:PROGRESS:LPS* persent)
  )
    )
  )
    
(defun bg:progress-clear ()
  (setq *BG:PROGRESS:MSG* nil)
  (setq *BG:PROGRESS:MAXLEN* nil)
  (setq *BG:PROGRESS:LPS* nil)
  (setvar "MODEMACRO" (vl-princ-to-string *BG:PROGRESS:OM*))
  ;;;(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
  (princ)
  )
(defun lib:conv-pickset-to-list (value / item lst)
       (repeat (setq item (sslength value)) ;_ end setq
         (setq lst (cons (ssname value (setq item (1- item))) lst))
         ) ;_ end repeat

  lst
  ) ;_ end of defun
(defun kpblc-error-save-sysvar (sysvar-list)
  (foreach item  sysvar-list
    (setq *kpblc-sysvar-list*
     (cons (list (car item) (getvar (car item))) *kpblc-sysvar-list*))
    (if  (cadr item)(_kpblc-sysvar-set (car item) (cadr item))) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of defun
(defun _kpblc-sysvar-set (sysvar value)
  (if (getvar sysvar)         ; Такая переменная есть вообще или нет?
    (if   (and (= value "")(wcmatch (strcase sysvar t) "dim*")) ;_ end of and
      (setvar sysvar ".")
      (vl-catch-all-apply 'setvar (list sysvar value))
      ) ;_ end of if
    ) ;_ end of if
  (getvar sysvar)
  ) ;_ end of defun
(defun kpblc-error-restore-sysvar ()
  (if *kpblc-sysvar-list*
    (foreach item *kpblc-sysvar-list* (_kpblc-sysvar-set (car item) (cadr item))))
  (setq *kpblc-sysvar-list* nil)(gc)) ;_ end of defun
(defun _kpblc-layer-status-save (layers-on / item)
      (or *kpblc-activedoc*
          (setq *kpblc-activedoc*
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 ) ;_ end of vla-get-activedocument
          ) ;_ end of setq
      ) ;_ end of or
      (if *kpblc-list-layer-status*
        (setq *kpblc-list-layer-status* nil)
      ) ;_ end of if
      (vlax-for item (vla-get-layers *kpblc-activedoc*)
        (setq *kpblc-list-layer-status*
               (append *kpblc-list-layer-status*
                       (list
                         (list item
                               (cons "freeze" (vla-get-freeze item))
                               (cons "lock" (vla-get-lock item))
                               (cons "on" (vla-get-layeron item))
                         ) ;_ end of list
                       ) ;_ end of list
               ) ;_ end of append
        ) ;_ end of setq
        (if layers-on
          (progn
            (vla-put-layeron item :vlax-true)
          ) ;_ end of if
        ) ;_ end of progn
        (vla-put-lock item :vlax-false)
        (if (not (equal (vla-get-activelayer *kpblc-activedoc*) item))
          (vla-put-freeze item :vlax-false)
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of defun
(defun _kpblc-layer-status-restore (/ item)
      (or *kpblc-activedoc*
          (setq *kpblc-activedoc*
                 (vla-get-activedocument
                   (vlax-get-acad-object)
                 ) ;_ end of vla-get-activedocument
          ) ;_ end of setq
      ) ;_ end of or
      (if *kpblc-list-layer-status*
        (progn
          (foreach item *kpblc-list-layer-status*
            (if (vlax-write-enabled-p (car item))
              (progn
                (VL-CATCH-ALL-APPLY '(lambda()
                (vla-put-layeron
                  (car item)
                  (cdr (assoc "on" (cdr item)))
                ) ;_ end of vla-put-layeron
                (vla-put-lock
                  (car item)
                  (cdr (assoc "lock" (cdr item)))
                ) ;_ end of vla-put-lock
                (if (not (equal (strcase (getvar "CLAYER"))
                                (strcase (vla-get-name (car item)))
                         ) ;_ end of equal
                    ) ;_ end of not
                  (vla-put-freeze
                    (car item)
                    (cdr (assoc "freeze" (cdr item)))
                  ) ;_ end of vla-put-freeze
                ) ;_ end of if
                                       )
                  )
              ) ;_ end of progn
            ) ;_ end of if
          ) ;_ end of foreach
          (setq *kpblc-list-layer-status* nil)
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun
(defun bg:massoc (key alist)
  ;;;lib:massoc mip_lib.lsp
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))

        (princ "\nhttp://forum.dwg.ru/showthread.php?p=1084041#post1084041")
    (princ "\nType Z0 in command line ver.2018-02-27")(princ)

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

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

;; ZeroZets. Free утилита для ZWCAD. Stol@2009(-11)
(setq zz_help_string (strcat
"    Утюг для Z (или ZeroZet)\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


(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