Lisp suggestions for creating civil point group

[johnd]

I am looking for suggestions as to how to create a point group based on cogo points that reside on or within a specified corridor width along a centerline. I have created a routine that defines the boundaries of the corridor but have had no luck applying it to a selection set to create the point group. I would also like this routine (or another) to create a group consisting of only the point at the vertex of a centerline. Any suggestions would be greatly appreciated

[CodeDing]

@johnd ,

Who is creating the Cogo Points? Because it would seem easier to just name them appropriately, such as "CENTER" or "OFFSET" so you can utilize the existing point group inclusion tools to add them to a point group.

Would that work?

Best,

~DD

[hosneyalaa]

Hi

Can you attached example drawing 

[johnd]

Here is a made up dwg I'm using for working this issue. The thick red polygon is what I'm using to define the boundary of the area I want to extract the points from. This I would like to be able to set an offset from from the centerline of it so that I could expand the area if needed or just use the points along the centerline.

Thanks,

[hosneyalaa · Accepted solution]

@johnd 

hi

try

; add cogo pts inside plines to points group
; By alan H Nov 2019
; helped by
;Source code Just notes from opie
;http://justopie.github.io/blog/2016/01/how-to-add-a-point-group-with-autolisp/
;;  https://www.theswamp.org/index.php?topic=55528.0

(defun c:ptspl ( / ss obj num ans)
(if (not OP:c3ddoc)(Load "add civ3d points to group.lsp")) ; change path if required
(while (setq plent (car (entsel "pick pline Enter to exit")))
(setq plist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))) ;;Select Polyline
(setq ss (ssget "_CP" plist '((0 . "AECC_COGO_POINT"))))
(setq gname (getstring "Enter point group name"))
(if (= (setq newgroup (getpointgroup gname)) nil)
(setq newgroup (AddPointGroup gname))
(princ "group Exists")
)
(repeat (setq x (sslength ss))
(setq obj (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))))
(setq num (vlax-get Obj 'Number))
(if (= (ContainsPoint newgroup num) nil)
(AddPointToGroup num newgroup)
)
)
)
)
(c:ptspl)

;Source code Just notes from opie
;http://justopie.github.io/blog/2016/01/how-to-add-a-point-group-with-autolisp/

(defun OP:c3ddoc (/ prod verstr c3dver)
    (defun c3dver (/ c3d *acad*)
      (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
    )
    (if	(not _C3DDoc) ;; Check to see if a global variable is set
      (setq
	_C3DDoc	(vla-get-activedocument
		  (vla-getinterfaceobject
		    (vlax-get-acad-object)
		    (strcat "AeccXUiLand.AeccApplication." (c3dver))
		  )
		)

      )
    )
    _C3DDoc  ;; Return reference to active civil 3d document object
)

(defun addorgetitem (objCollection strName / objFromCollection)
  (or (= (type (setq objFromCollection
              (vl-catch-all-apply
            'vla-add
            (list objCollection strName)
              )
           )
     )
     'VLA-OBJECT
      )
      (= (type (setq objFromCollection
              (vl-catch-all-apply
            'vla-item
            (list objCollection strName)
              )
           )
     )
     'VLA-OBJECT
      )
  )
  (if (= (type objFromCollection) 'VL-CATCH-ALL-APPLY-ERROR)
    (setq objFromCollection nil)
    objFromCollection
  )
)

(defun AddPointGroup (strName / objGroup objGroups)
  (if (and (setq objGroups (vlax-get-property (op:c3ddoc) 'PointGroups))
	   (setq objGroup (addorgetitem objGroups strName))
      )
    objGroup
  )
)
;(AddPointGroup "group3")

(defun GetPointGroup (strName / objGroup objGroups)
  (if (and (setq objGroups (vlax-get-property (op:c3ddoc) 'PointGroups))
	   (= 'VLA-OBJECT (type (setq objGroup (vl-catch-all-apply 'vla-item (list objGroups strName)))))
      )
    objGroup
  )
)
;(setq newgroup (getpointgroup "Group5"))

(defun ContainsPoint (objGroup intPoint /)
  (if (and (= (type intPoint) 'INT)
       (= (type objGroup) 'VLA-OBJECT)
       (= (vla-get-ObjectName objGroup) "AeccDbPG")
      )
    (= -1 (vlax-invoke objGroup 'ContainsPoint intPoint))
  )
)
;(re

(defun GetQueryBuilder (objGroup)
  (if (and (= (type objGroup) 'VLA-OBJECT)
           (= (vla-get-ObjectName objGroup) "AeccDbPG")
      )
    (vlax-get-property objGroup 'QueryBuilder)
  )
)

(defun AddPointToGroup (intPoint objGroup / objQB)
  (if (and (= (type intPoint) 'int)
           (= (type objGroup) 'VLA-OBJECT)
           (= (vla-get-ObjectName objGroup) "AeccDbPG")
           (not (ContainsPoint objGroup intPoint))
      )
    (progn
      (setq objQB         (GetQueryBuilder objGroup)
        strIncludedNumbers (vlax-get-property objQB 'IncludeNumbers)
      )
      (if (> (strlen strIncludedNumbers) 0)
        (vlax-put-property objQB 'IncludeNumbers (strcat strIncludedNumbers "," (itoa intPoint)))
        (vlax-put-property objQB 'IncludeNumbers  (itoa intPoint))
      )
    )
  )
)
; (AddPointToGroup 1 newGroup)
; (AddPointToGroup 2 newGroup)
; (AddPointToGroup 3 newGroup)

[johnd]

thanks, i will give this a try.

[johnd]

Thank you. That is just what I needed.

[hosneyalaa]

I am happy this is helps you