Author Topic: Move Points Thawed into a New PointGroup  (Read 162 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Water Moccasin
  • Posts: 1799
  • I can't remeber what I already asked! I need help!
Move Points Thawed into a New PointGroup
« on: December 07, 2016, 12:12:10 pm »
I am trying to figure out how I can take the points that are shown on the screen, to a new point group with a point style "no plot" and a label style "no plot" within a routine of some sorts. I am looking around and can not seem to find how to create a point group in lisp. lol. Thanks again guys.
Autodesk Infrastructure Design Suite 2016

Jeff_M

  • King Gator
  • Posts: 3850
  • C3D user & customizer
Re: Move Points Thawed into a New PointGroup
« Reply #1 on: December 07, 2016, 12:35:35 pm »
To create a PointGroup:

Code - Auto/Visual Lisp: [Select]
  1. ;;Function to add a PointGroup if it doesn't exist.
  2. (defun CreatePG (grpname / C3D C3Ddoc exists grps)
  3.  (if (and (setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
  4.     (if vlax-user-product-key
  5.       (vlax-user-product-key)
  6.       (vlax-product-key)
  7.     )
  8.     )
  9. C3D (vl-registry-read C3D "Release")
  10. C3D (substr
  11.       C3D
  12.       1
  13.       (vl-string-search
  14. "."
  15. C3D
  16. (+ (vl-string-search "." C3D) 1)
  17.       )
  18.     )
  19.       (strcat "AeccXUiLand.AeccApplication." C3D)
  20.     )
  21.   )
  22.   (setq C3Ddoc (vla-get-activedocument C3D))
  23.   (setq grps (vlax-get C3Ddoc 'pointgroups))
  24.      )
  25.    (progn
  26.      (vlax-for pg grps
  27. (if (eq (vlax-get pg 'name) grpname)
  28.  (setq exists t)
  29.  )
  30. )
  31.      (if (not exists)
  32. (vlax-invoke-method grps 'Add grpname)
  33. )
  34.      )
  35.    )
  36.  (princ)
  37.  )
  38.  
  39.  
  40. ;;once the above is loaded, call the function with the desired PointGroup name
  41. (createPG "NO DISPLAY")
  42.  

MSTG007

  • Water Moccasin
  • Posts: 1799
  • I can't remeber what I already asked! I need help!
Re: Move Points Thawed into a New PointGroup
« Reply #2 on: December 07, 2016, 01:14:09 pm »
Thanks Jeff. I can now create a point group. I am messing around with the selection set.

Code: [Select]
(ssget "_W" '(-5000 -5000) '(5000000 5000000) '((0 . "AECC_COGO_POINT")))
I was trying to use this to select all the thawed points on the screen from a zoom extents.

I am still trying to figure how I can move the selection set to the new point group and change the styles.

Again thanks for the help!
Autodesk Infrastructure Design Suite 2016

Jeff_M

  • King Gator
  • Posts: 3850
  • C3D user & customizer
Re: Move Points Thawed into a New PointGroup
« Reply #3 on: December 07, 2016, 01:41:08 pm »
Use the SYVAR's EXTMIN & EXTMAX to determine the Crossing window. Loop through the resulting selection set, gather the point numbers from the points into a string (should format the string just as you would type it into the PointGroup properties to Include Points), then pass the string like so (I modified the function previously posted to return the PG, whether it exists or not).

Code - Auto/Visual Lisp: [Select]
  1. ;;Function to add a PointGroup if it doesn't exist.
  2. (defun CreatePG (grpname / C3D C3Ddoc exists grps)
  3.  (if (and (setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
  4.     (if vlax-user-product-key
  5.       (vlax-user-product-key)
  6.       (vlax-product-key)
  7.     )
  8.     )
  9. C3D (vl-registry-read C3D "Release")
  10. C3D (substr
  11.       C3D
  12.       1
  13.       (vl-string-search
  14. "."
  15. C3D
  16. (+ (vl-string-search "." C3D) 1)
  17.       )
  18.     )
  19.       (strcat "AeccXUiLand.AeccApplication." C3D)
  20.     )
  21.   )
  22.   (setq C3Ddoc (vla-get-activedocument C3D))
  23.   (setq grps (vlax-get C3Ddoc 'pointgroups))
  24.      )
  25.    (progn
  26.      (vlax-for pg grps
  27. (if (eq (vlax-get pg 'name) grpname)
  28.  (setq exists pg)
  29.  )
  30. )
  31.      (if (not exists)
  32. (setq exists (vlax-invoke-method grps 'Add grpname))
  33. )
  34.      )
  35.    )
  36.  exists
  37.  )
  38.  
  39. ;;once the above is loaded, call the function with the desired PointGroup name
  40. (setq pg (createPG "NO DISPLAY"))
  41. (setq pgquery (vlax-get pg 'querybuilder))
  42. (setq pnString "1-10,20-25")
  43. (vlax-put pgquery 'includenumbers pnString)
  44.  
  45.  
I believe that Kerry "kdub" MP posted a lisp function to parse a formatted string from a bunch of numbers. I will try to locate that for you. The name of it was IntsToRangedString and was posted c. 2006
« Last Edit: December 07, 2016, 01:49:22 pm by Jeff_M »

Jeff_M

  • King Gator
  • Posts: 3850
  • C3D user & customizer
Re: Move Points Thawed into a New PointGroup
« Reply #4 on: December 07, 2016, 02:05:23 pm »
Here's a link to the thread with the other function...which was addressed by a number of others, as well. Good reading!

https://www.theswamp.org/index.php?topic=12943.0

MSTG007

  • Water Moccasin
  • Posts: 1799
  • I can't remeber what I already asked! I need help!
Re: Move Points Thawed into a New PointGroup
« Reply #5 on: December 07, 2016, 03:58:00 pm »
I think I need to stop over thinking this..

Code: [Select]
;;Function to add a PointGroup 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

  )

(defun intstorangedstring (ints / sorted result x y )
  (setq sorted (vl-sort ints '>)
        x      (car sorted)
        sorted (cdr sorted)
        result (list (vl-princ-to-string x))
  )
  (while (setq y (car sorted))
    (setq sorted (cdr sorted))
    (cond
      ((and (= (1+ y) x) (= (1- y) (car sorted)))
       (if (/= (car result) "-") (setq result (cons "-" result)))
      )
      ((= (car result) "-")
       (setq result (cons (vl-princ-to-string y) result))
       )
      ((setq result (cons (vl-princ-to-string y) (cons "," result))))
    )
    (setq x y)
  )
 (apply 'strcat result)
)

 

;;once the above is loaded, call the function with the desired PointGroup name

(setq pg (createPG "NO DISPLAY"))

(setq pgquery (vlax-get pg 'querybuilder))

;;(setq pnString (intstorangedstring '(1 3 4 5 8 10 11 14 15 16)))

(setq pnString "1-10,20-25")

(vlax-put pgquery 'includenumbers pnString)

 



Autodesk Infrastructure Design Suite 2016

Jeff_M

  • King Gator
  • Posts: 3850
  • C3D user & customizer
Re: Move Points Thawed into a New PointGroup
« Reply #6 on: December 07, 2016, 06:45:06 pm »
Here's code which works, for the most part. Unfortunately, the C3D API does not allow us to set the PointGroup's PointStyle & PointLabelStyle properties to "<none>". This has been a long standing issue, and it still remains in C3D2017's COM API. If you already have the NO DISPLAY group, and it has point numbers already included, then you may want to adjust this to allow the keeping of those existing point numbers.

Code - Auto/Visual Lisp: [Select]
  1. ;;Civil 3d - Tool to place all currently visible Cogo Points in a new PointGroup
  2.  
  3. (defun c:HideDisplayedPoints
  4.       (/ ENT IDX PG PGQUERY PNSTRING PNTNUMS PNTOBJ SS)
  5.  ;;Function to return a PointGroup or add it if it doesn't exist.
  6.  (defun CreatePG (grpname / C3D C3Ddoc exists grps)
  7.    (vl-load-com)
  8.    (if (and (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.     (setq grps (vlax-get C3Ddoc 'pointgroups))
  27. )
  28.      (progn
  29. (vlax-for pg grps
  30.  (if (eq (vlax-get pg 'name) grpname)
  31.    (setq exists pg)
  32.  )
  33. )
  34. (if (not exists)
  35.  (setq exists (vlax-invoke-method grps 'Add grpname))
  36. )
  37.      )
  38.    )
  39.    exists
  40.  )
  41.  
  42.  ;;next 2 functions as posted to the Swamp by ElpanovEvgeniy (except edited function names)
  43.  ;; https://www.theswamp.org/index.php?topic=12943.msg157773#msg157773
  44.  (defun ints2rangedstring (lst)
  45.    (if lst
  46.      (if (listp (car lst))
  47. (if (cadr lst)
  48.  (if (equal (1+ (cadar lst)) (cadr lst) 1e-8)
  49.    (ints2rangedstring
  50.      (cons (list (caar lst) (cadr lst)) (cddr lst))
  51.    )
  52.    (strcat (itoa (caar lst))
  53.    "-"
  54.    (itoa (cadar lst))
  55.    ","
  56.    (ints2rangedstring (cdr lst))
  57.    )
  58.  ) ;_  if
  59.  (strcat (itoa (caar lst)) "-" (itoa (cadar lst)))
  60. ) ;_  if
  61. (if (cadr lst)
  62.  (if (equal (1+ (car lst)) (cadr lst) 1e-8)
  63.    (ints2rangedstring
  64.      (cons (list (car lst) (cadr lst)) (cddr lst))
  65.    )
  66.    (strcat (itoa (car lst)) "," (ints2rangedstring (cdr lst)))
  67.  ) ;_  if
  68.  (itoa (car lst))
  69. ) ;_  if
  70.      ) ;_  if
  71.      ""
  72.    ) ;_  if
  73.  )
  74.  
  75.  ;;not used, but left in in case the need to update an existing string arises
  76.  (defun rangedstring2list (s)
  77.    (if s
  78.      (if (listp s)
  79. (if (and (cadar s) (< (caar s) (cadar s)))
  80.  (cons (caar s)
  81. (rangedstring2list
  82.  (cons (list (1+ (caar s)) (cadar s)) (cdr s))
  83. )
  84.  )
  85.  (cons (caar s) (rangedstring2list (cdr s)))
  86. )
  87. (rangedstring2list
  88.  (read
  89.    (strcat
  90.      "(("
  91.      (apply
  92.    (lambda (x)
  93.      (cond
  94. ((< 47 x 58) (chr x))
  95. ((= 44 x) ")(")
  96. ((= 45 x) " ")
  97.      ) ;_  cond
  98.    ) ;_  lambda
  99.  ) ;_  function
  100.  (vl-string->list s)
  101. ) ;_  mapcar
  102.      ) ;_  apply
  103.      "))"
  104.    ) ;_  strcat
  105.  ) ;_  read
  106. ) ;_  test
  107.      ) ;_  if
  108.    ) ;_  if
  109.  )
  110.  
  111.  ;;main part of this tool
  112.  (if (setq ss (ssget "C"
  113.      (getvar 'extmin)
  114.      (getvar 'extmax)
  115.      '((0 . "AECC_COGO_POINT"))
  116.       )
  117.      )
  118.    (progn
  119.      (setq idx -1)
  120.      (while (setq ent (ssname ss (setq idx (1+ idx))))
  121. (setq pntobj (vlax-ename->vla-object ent))
  122. (if (not pntnums)
  123.  (setq pntnums (list (vlax-get pntobj 'number)))
  124.  (setq pntnums (cons (vlax-get pntobj 'number) pntnums))
  125. )
  126.      )
  127.      (setq pg (createPG "NO DISPLAY"))
  128.      (vlax-put pg 'overridepointstyle :vlax-true)
  129.      (vlax-put pg 'overridepointlabelstyle :vlax-true)
  130.      (setq pgquery (vlax-get pg 'querybuilder))
  131.      (setq pnString (ints2rangedstring pntnums))
  132.      (vlax-put pgquery 'includenumbers pnString)
  133.    )
  134.  )
  135.  (princ)
  136. )
  137.  
  138.  

MSTG007

  • Water Moccasin
  • Posts: 1799
  • I can't remeber what I already asked! I need help!
Re: Move Points Thawed into a New PointGroup
« Reply #7 on: December 08, 2016, 08:57:39 am »
Jeff, it worked! I still have a hard time understanding how to combine the different routines into one. I get what the different routines do, but placing them together so they interact with eachother is still a challenge. Thank you again Jeff. and again... and again.... lol
Autodesk Infrastructure Design Suite 2016