Author Topic: Move Points Thawed into a New PointGroup  (Read 3927 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!
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.
Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • 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.                  C3D (vla-getinterfaceobject
  20.                        (vlax-get-acad-object)
  21.                        (strcat "AeccXUiLand.AeccApplication." C3D)
  22.                      )
  23.            )
  24.            (setq C3Ddoc (vla-get-activedocument C3D))
  25.            (setq grps (vlax-get C3Ddoc 'pointgroups))
  26.       )
  27.     (progn
  28.       (vlax-for pg grps
  29.         (if (eq (vlax-get pg 'name) grpname)
  30.           (setq exists t)
  31.           )
  32.         )
  33.       (if (not exists)
  34.         (vlax-invoke-method grps 'Add grpname)
  35.         )
  36.       )
  37.     )
  38.   (princ)
  39.   )
  40.  
  41.  
  42. ;;once the above is loaded, call the function with the desired PointGroup name
  43. (createPG "NO DISPLAY")
  44.  

MSTG007

  • Gator
  • Posts: 2598
  • 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!
Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • 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.                  C3D (vla-getinterfaceobject
  20.                        (vlax-get-acad-object)
  21.                        (strcat "AeccXUiLand.AeccApplication." C3D)
  22.                      )
  23.            )
  24.            (setq C3Ddoc (vla-get-activedocument C3D))
  25.            (setq grps (vlax-get C3Ddoc 'pointgroups))
  26.       )
  27.     (progn
  28.       (vlax-for pg grps
  29.         (if (eq (vlax-get pg 'name) grpname)
  30.           (setq exists pg)
  31.           )
  32.         )
  33.       (if (not exists)
  34.         (setq exists (vlax-invoke-method grps 'Add grpname))
  35.         )
  36.       )
  37.     )
  38.   exists
  39.   )
  40.  
  41. ;;once the above is loaded, call the function with the desired PointGroup name
  42. (setq pg (createPG "NO DISPLAY"))
  43. (setq pgquery (vlax-get pg 'querybuilder))
  44. (setq pnString "1-10,20-25")
  45. (vlax-put pgquery 'includenumbers pnString)
  46.  
  47.  
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: 4087
  • 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

  • Gator
  • Posts: 2598
  • 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)

 



Civil3D 2020

Jeff_M

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

MSTG007

  • Gator
  • Posts: 2598
  • 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
Civil3D 2020