Le portail francophone de la géomatique

;;
;; ZH par GC
;; Sélectionne les objets présents dans l'espace courant d'après leurs "handle"
;;

(defun c:zh (/ space ss obj hlst olst kw i l)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq space (vla-get-Block (vla-get-ActiveLayout *acdoc*))
ss (ssadd)
)
(sssetfirst nil nil)
(initget 1)
(setq hlst
(getstring
"\nEntrez les handles à sélectionner séparés par des virgules: "
)
hlst (str2lst hlst ",")
)
(foreach h hlst
(if
(and
(not (vl-catch-all-error-p
(setq obj (vl-catch-all-apply
'vla-HandleToObject
(list *acdoc* h)
)
)
)
)
(equal (vla-ObjectIdToObject *acdoc* (vla-get-OwnerId obj))
space
)
)
(progn
(setq olst (cons obj olst))
(ssadd (vlax-vla-object->ename obj) ss)
)
)
)
(if ss
(progn
(sssetfirst nil nil)
(sssetfirst nil ss)
(setq i -1
l (length olst)
)
(while
(and
(not (initget "Suivant Précédent Tous"))
(or (setq
kw (getkword "Zoom sur [Suivant/Précédent/Tous] <S>: ")
)
(setq kw "Suivant")
)
)
(if (= kw "Suivant")
(setq i (rem (1+ i) l))
(setq i (if (minusp (1- i))
(1- l)
(1- i)
)
)
)
(if (= kw "Tous")
(ZoomObject olst)
(ZoomObject (list (nth i olst)))
)
)
)
)
(princ)
)

;; ZoomObject Effectue un zoom sur les objets contenus dans la liste
;;
;; Argument
;; objlst : une liste de vla-object
;;
;; Variables
;; dir : normale du plan de la vue courante
;; ang : angle de la vue courante
;; 3x3 : matrice de transformation du SCG vers la vue courante (dimension 3)
;; 4x4 : matrice de transformation du SCG vers la vue courante (dimension 4)
;; ptlst : liste des points minimum et maximum des bounding-boxes des objets sélectionnés (SCG)

(defun ZoomObject (objlst / dir ang 3x3 4x4 ptlst)
(vl-load-com)
(setq dir (trans '(0 0 1) 2 0 T)
ang (- (getvar "viewtwist"))
3x3 (mxm (mapcar '(lambda (x) (trans x 0 dir))
'((1 0 0) (0 1 0) (0 0 1))
)
(list (list (cos ang) (- (sin ang)) 0)
(list (sin ang) (cos ang) 0)
'(0 0 1)
)
)
4x4 (append
(mapcar
'(lambda (v o)
(append v (list o))
)
3x3
'(0 0 0)
)
(list '(0 0 0 1))
)
)
(foreach obj objlst
(vla-TransformBy obj (vlax-tmatrix (trp 4x4)))
(vla-getBoundingBox obj 'minpt 'maxpt)
(vla-TransformBy obj (vlax-tmatrix 4x4))
(setq ptlst (cons (vlax-safearray->list minpt)
(cons (vlax-safearray->list maxpt) ptlst)
)
)
)
(vla-ZoomWindow
(vlax-get-acad-object)
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'min ptlst))))
(vlax-3d-point (mxv 3x3 (apply 'mapcar (cons 'max ptlst))))
)
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur

(defun str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
(cons (substr str 1 pos)
(str2lst (substr str (+ (strlen sep) pos 1)) sep)
)
(list str)
)
) 

;; transpose une matrice Doug Wilson

(defun trp (m)
(apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky

(defun mxv (m v)
(mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
)

;; Multiply two matrices by Vladimir Nesterovsky

(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)