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
|