Leaderboard

(defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) ( (/= (rem (length o_lst) grp) 0) (princ "\nModulus Error : The passed list length is not exactly divisible by the group size!!")) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun rh:223 (lst z / a) (setq a (mapcar '(lambda (x) (reverse (cons z (reverse x)))) lst))) ;;Object ID (defun c:oid ( / *error* c_doc c_spc sv_lst sv_vals level p0 p1) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred."))) (princ) );end_*error*_defun (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) sv_lst (list 'osmode 'cmdecho) sv_vals (mapcar 'getvar sv_lst) );end_setq (mapcar 'setvar sv_lst '(0 0)) (cond ( (null (tblsearch "LAYER" "LABEL")) (vlax-put (vla-add (vla-get-layers c_doc) "LABEL") 'color 7))) (setq ss (ssget '((0 . "POINT,CIRCLE,LINE,LWPOLYLINE")))) (cond (ss (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) (vla-startundomark c_doc) (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (cond ( (= (vlax-get-property obj 'objectname) "AcDbLine") (setq i_pts (mapcar '(lambda (x) (vlax-get obj x)) (list "startpoint" "endpoint")))) ( (= (vlax-get-property obj 'objectname) "AcDbCircle") (setq i_pts (rh:sammlung_n (vlax-get obj 'center) 3))) ( (= (vlax-get-property obj 'objectname) "AcDbPoint") (setq i_pts (rh:sammlung_n (vlax-get obj 'coordinates) 3))) (t (setq i_pts (rh:223 (rh:sammlung_n (vlax-get obj 'coordinates) 2) 0.0))) );end_cond (foreach pt i_pts (setq pt2 (mapcar '+ pt '(1.0 1.0 0.0)) txt (strcat "E=" (rtos (car pt) 2 4) "\\P" "N=" (rtos (cadr pt) 2 4)) ml_obj (vlax-invoke c_spc 'addmleader (append pt pt2) 0) );end_setq (mapcar '(lambda (x y) (vlax-put-property ml_obj x y)) (list 'textstring 'layer 'textleftattachmenttype 'textrightattachmenttype) (list txt "LABEL" 7 7)) );end_foreach );end_repeat (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc)) ) );end_cond (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun