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

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Water Moccasin
  • Posts: 2374
  • 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 »
Autodesk Infrastructure Design Suite 2019

mjfarrell

  • Seagull
  • Posts: 14440
  • 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: 3939
  • 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.      )
  12.      )
  13.  C3D (vl-registry-read C3D "Release")
  14.  C3D (substr
  15. C3D
  16. 1
  17.  "."
  18.  C3D
  19.  (+ (vl-string-search "." C3D) 1)
  20. )
  21.      )
  22. (strcat "AeccXUiLand.AeccApplication." C3D)
  23.      )
  24.    )
  25.    (setq C3Ddoc (vla-get-activedocument C3D))
  26.  )
  27.  
  28.  (defun CreatePG (grpname / exists grps)
  29.    (setq grps (vlax-get C3Ddoc 'pointgroups))
  30.    (vlax-for pg grps
  31.      (if (eq (vlax-get pg 'name) grpname)
  32. (setq exists pg)
  33.      )
  34.    )
  35.    (if (not exists)
  36.      (setq exists (vlax-invoke-method grps 'Add grpname))
  37.    )
  38.    exists
  39.  )
  40.  
  41.  ;;next 2 functions as posted to the Swamp by ElpanovEvgeniy (except edited function names)
  42.  ;; https://www.theswamp.org/index.php?topic=12943.msg157773#msg157773
  43.  (defun ints2rangedstring (lst)
  44.    (if lst
  45.      (if (listp (car lst))
  46. (if (cadr lst)
  47.  (if (equal (1+ (cadar lst)) (cadr lst) 1e-8)
  48.    (ints2rangedstring
  49.      (cons (list (caar lst) (cadr lst)) (cddr lst))
  50.    )
  51.    (strcat (itoa (caar lst))
  52.    "-"
  53.    (itoa (cadar lst))
  54.    ","
  55.    (ints2rangedstring (cdr lst))
  56.    )
  57.  ) ;_  if
  58.  (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
  59. ) ;_  if
  60. (if (cadr lst)
  61.  (if (equal (1+ (car lst)) (cadr lst) 1e-8)
  62.    (ints2rangedstring
  63.      (cons (list (car lst) (cadr lst)) (cddr lst))
  64.    )
  65.    (strcat (itoa (car lst)) "," (ints2rangedstring (cdr lst)))
  66.  ) ;_  if
  67.  (itoa (car lst))
  68. ) ;_  if
  69.      ) ;_  if
  70.      ""
  71.    ) ;_  if
  72.  )
  73.  
  74.  
  75.  ;;main part of this tool
  76.  (getC3D)
  77.  (setq sname
  78.   "\nEnter name of PointStyle of points to add to the No Display Group: "
  79. )
  80.  )
  81.  (if (and sname
  82.   (/= "" sname)
  83.      )
  84.    (progn
  85.      (setq points (vlax-get C3Ddoc 'points))
  86.      (vlax-for pntobj points
  87. (if (setq style (vlax-get pntobj 'style))
  88. (if (= (vlax-get style 'name) sname)
  89.  (if (not pntnums)
  90.    (setq pntnums (list (vlax-get pntobj 'number)))
  91.    (setq pntnums (cons (vlax-get pntobj 'number) pntnums))
  92.  )
  93. )
  94.  )
  95.      )
  96.      (setq pg (createPG "NO DISPLAY"))
  97.      (vlax-put pg 'overridepointstyle :vlax-true)
  98.      (vlax-put pg 'overridepointlabelstyle :vlax-true)
  99.      (setq pgquery (vlax-get pg 'querybuilder))
  100.      (setq pnString (ints2rangedstring pntnums))
  101.      (vlax-put pgquery 'includenumbers pnString)
  102.    )
  103.  )
  104.  (princ)
  105. )
  106.  

MSTG007

  • Water Moccasin
  • Posts: 2374
  • 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.
Autodesk Infrastructure Design Suite 2019