;;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))
)