0 Members and 1 Guest are viewing this topic.
;;Civil 3d - Tool to place all currently visible Cogo Points in a new PointGroup (defun c:HideDisplayedPoints (/ ENT IDX PG PGQUERY PNSTRING PNTNUMS PNTOBJ SS) ;;Function to return a PointGroup or add it if it doesn't exist. (defun CreatePG (grpname / C3D C3Ddoc exists grps) (vl-load-com) (if (and (setq C3D (strcat "HKEY_LOCAL_MACHINE\\" (if vlax-user-product-key (vlax-user-product-key) (vlax-product-key) ) ) C3D (vl-registry-read C3D "Release") C3D (substr C3D 1 (vl-string-search "." C3D (+ (vl-string-search "." C3D) 1) ) ) C3D (vla-getinterfaceobject (vlax-get-acad-object) (strcat "AeccXUiLand.AeccApplication." C3D) ) ) (setq C3Ddoc (vla-get-activedocument C3D)) (setq grps (vlax-get C3Ddoc 'pointgroups)) ) (progn (vlax-for pg grps (if (eq (vlax-get pg 'name) grpname) (setq exists pg) ) ) (if (not exists) (setq exists (vlax-invoke-method grps 'Add grpname)) ) ) ) exists ) ;;next 2 functions as posted to the Swamp by ElpanovEvgeniy (except edited function names) ;; https://www.theswamp.org/index.php?topic=12943.msg157773#msg157773 (defun ints2rangedstring (lst) (if lst (if (listp (car lst)) (if (cadr lst) (if (equal (1+ (cadar lst)) (cadr lst) 1e-8) (ints2rangedstring (cons (list (caar lst) (cadr lst)) (cddr lst)) ) (strcat (itoa (caar lst)) "-" (itoa (cadar lst)) "," (ints2rangedstring (cdr lst)) ) ) ;_ if (strcat (itoa (caar lst)) "-" (itoa (cadar lst))) ) ;_ if (if (cadr lst) (if (equal (1+ (car lst)) (cadr lst) 1e-8) (ints2rangedstring (cons (list (car lst) (cadr lst)) (cddr lst)) ) (strcat (itoa (car lst)) "," (ints2rangedstring (cdr lst))) ) ;_ if (itoa (car lst)) ) ;_ if ) ;_ if "" ) ;_ if ) ;;not used, but left in in case the need to update an existing string arises (defun rangedstring2list (s) (if s (if (listp s) (if (and (cadar s) (< (caar s) (cadar s))) (cons (caar s) (rangedstring2list (cons (list (1+ (caar s)) (cadar s)) (cdr s)) ) ) (cons (caar s) (rangedstring2list (cdr s))) ) (rangedstring2list (read (strcat "((" (apply (function strcat) (mapcar (function (lambda (x) (cond ((< 47 x 58) (chr x)) ((= 44 x) ")(") ((= 45 x) " ") ) ;_ cond ) ;_ lambda ) ;_ function (vl-string->list s) ) ;_ mapcar ) ;_ apply "))" ) ;_ strcat ) ;_ read ) ;_ test ) ;_ if ) ;_ if ) ;;main part of this tool (if (setq ss (ssget "C" (getvar 'extmin) (getvar 'extmax) '((0 . "AECC_COGO_POINT")) ) ) (progn (setq idx -1) (while (setq ent (ssname ss (setq idx (1+ idx)))) (setq pntobj (vlax-ename->vla-object ent)) (if (not pntnums) (setq pntnums (list (vlax-get pntobj 'number))) (setq pntnums (cons (vlax-get pntobj 'number) pntnums)) ) ) (setq pg (createPG "NO DISPLAY")) (vlax-put pg 'overridepointstyle :vlax-true) (vlax-put pg 'overridepointlabelstyle :vlax-true) (setq pgquery (vlax-get pg 'querybuilder)) (setq pnString (ints2rangedstring pntnums)) (vlax-put pgquery 'includenumbers pnString) ) ) (princ))
(if (not pntnums) (setq pntnums (list (vlax-get pntobj 'number))) (setq pntnums (cons (vlax-get pntobj 'number) pntnums)) )