Author Topic: Civil3D - Point Style to Point Group  (Read 5086 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Civil3D - Point Style to Point Group
« on: May 17, 2019, 11:14:33 AM »
I figured I would ask.

Jeff was nice enough awhile ago to put together this code. It works. But, I was hoping I could get it filter by a point label style rather than what is visible on the screen.

https://www.theswamp.org/index.php?topic=52379.msg573254#msg573254

Code: [Select]
;;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)

)
« Last Edit: May 17, 2019, 11:48:43 AM by MSTG007 »
Civil3D 2020

mjfarrell

  • Seagull
  • Posts: 14444
  • Every Student their own Lesson
Re: Civil3D - Point Style to Point Group
« Reply #1 on: May 17, 2019, 02:31:22 PM »
Code: [Select]
(if (not pntnums)

  (setq pntnums (list (vlax-get pntobj 'number)))

  (setq pntnums (cons (vlax-get pntobj 'number) pntnums))

)


mayhaps this portion can be changed to read pntstyle?
Be your Best


Michael Farrell
http://primeservicesglobal.com/

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D - Point Style to Point Group
« Reply #2 on: May 18, 2019, 10:30:54 AM »
This will do what you want.
Code - Auto/Visual Lisp: [Select]
  1. ;;Civil 3d - Tool to place all Cogo Points with a specific style in the No Display PointGroup
  2.  
  3. (defun c:HidePointsByStyle
  4.        (/ C3D C3Ddoc ENT IDX PG PGQUERY PNSTRING PNTNUMS PNTOBJ SS)
  5.   ;;Function to return a PointGroup or add it if it doesn't exist.
  6.   (defun getC3D ()
  7.     (vl-load-com)
  8.     (setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
  9.                       (if vlax-user-product-key
  10.                         (vlax-user-product-key)
  11.                         (vlax-product-key)
  12.                       )
  13.               )
  14.           C3D (vl-registry-read C3D "Release")
  15.           C3D (substr
  16.                 C3D
  17.                 1
  18.                 (vl-string-search
  19.                   "."
  20.                   C3D
  21.                   (+ (vl-string-search "." C3D) 1)
  22.                 )
  23.               )
  24.           C3D (vla-getinterfaceobject
  25.                 (vlax-get-acad-object)
  26.                 (strcat "AeccXUiLand.AeccApplication." C3D)
  27.               )
  28.     )
  29.     (setq C3Ddoc (vla-get-activedocument C3D))
  30.   )
  31.  
  32.   (defun CreatePG (grpname / exists grps)
  33.     (setq grps (vlax-get C3Ddoc 'pointgroups))
  34.     (vlax-for pg grps
  35.       (if (eq (vlax-get pg 'name) grpname)
  36.         (setq exists pg)
  37.       )
  38.     )
  39.     (if (not exists)
  40.       (setq exists (vlax-invoke-method grps 'Add grpname))
  41.     )
  42.     exists
  43.   )
  44.  
  45.   ;;next 2 functions as posted to the Swamp by ElpanovEvgeniy (except edited function names)
  46.   ;; https://www.theswamp.org/index.php?topic=12943.msg157773#msg157773
  47.   (defun ints2rangedstring (lst)
  48.     (if lst
  49.       (if (listp (car lst))
  50.         (if (cadr lst)
  51.           (if (equal (1+ (cadar lst)) (cadr lst) 1e-8)
  52.             (ints2rangedstring
  53.               (cons (list (caar lst) (cadr lst)) (cddr lst))
  54.             )
  55.             (strcat (itoa (caar lst))
  56.                     "-"
  57.                     (itoa (cadar lst))
  58.                     ","
  59.                     (ints2rangedstring (cdr lst))
  60.             )
  61.           ) ;_  if
  62.           (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
  63.         ) ;_  if
  64.         (if (cadr lst)
  65.           (if (equal (1+ (car lst)) (cadr lst) 1e-8)
  66.             (ints2rangedstring
  67.               (cons (list (car lst) (cadr lst)) (cddr lst))
  68.             )
  69.             (strcat (itoa (car lst)) "," (ints2rangedstring (cdr lst)))
  70.           ) ;_  if
  71.           (itoa (car lst))
  72.         ) ;_  if
  73.       ) ;_  if
  74.       ""
  75.     ) ;_  if
  76.   )
  77.  
  78.  
  79.   ;;main part of this tool
  80.   (getC3D)
  81.   (setq sname
  82.          (getstring
  83.            "\nEnter name of PointStyle of points to add to the No Display Group: "
  84.          )
  85.   )
  86.   (if (and sname
  87.            (/= "" sname)
  88.       )
  89.     (progn
  90.       (setq points (vlax-get C3Ddoc 'points))
  91.       (vlax-for pntobj points
  92.         (if (setq style (vlax-get pntobj 'style))
  93.         (if (= (vlax-get style 'name) sname)
  94.           (if (not pntnums)
  95.             (setq pntnums (list (vlax-get pntobj 'number)))
  96.             (setq pntnums (cons (vlax-get pntobj 'number) pntnums))
  97.           )
  98.         )
  99.           )
  100.       )
  101.       (setq pg (createPG "NO DISPLAY"))
  102.       (vlax-put pg 'overridepointstyle :vlax-true)
  103.       (vlax-put pg 'overridepointlabelstyle :vlax-true)
  104.       (setq pgquery (vlax-get pg 'querybuilder))
  105.       (setq pnString (ints2rangedstring pntnums))
  106.       (vlax-put pgquery 'includenumbers pnString)
  107.     )
  108.   )
  109.   (princ)
  110. )
  111.  

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D - Point Style to Point Group
« Reply #3 on: May 18, 2019, 10:34:29 AM »
Ahhhh Jeff. Thank you, I was trying different varibles to get it to work, but no luck. Thank you again.
Civil3D 2020