topic Re: Lisp Routine for Connecting civil Points by description in Civil 3D Customization Forum

Lisp Routine for Connecting civil Points by description

RickfromtheNorth — Wed, 25 May 2022 15:33:42 GMT

Hello Everyone, New to forums was wondering if anyone could look at my code to see what might be wrong with this.

Two part program one to draw 2d poly between points that have the same raw description and the other one to draw a 3d poly between points with same raw description. Perhaps something already exists that is better than my code.

Thanks in advance.

(defun c:J2D (/ DESCENT FLT LOCS2D LOCS3D OBJ OBJS) (setq descEnt (car (entsel "\nPick Cogo Point for description to draw poly:"))) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:LWPoly locs2d) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun JP:LWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst))) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:J3D (/ DESCENT FLT LOCS2D LOCS3D OBJ OBJS) (setq descEnt (car (entsel "\nPick Cogo Point for description to filter by:"))) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:make3dpoly locs3d) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun JP:make3dpoly (lst) (entmake (list (cons 0 "POLYLINE") (cons 66 1) (cons 100 "AcDb3dPolyline") '(70 . 8))) (foreach pt lst (entmake (list (cons 0 "VERTEX") '(100 . "AcDb3dPolylineVertex") '(70 . 32) (cons 10 pt)))) (entmake '((0 . "SEQEND")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Re: Lisp Routine for Connecting civil Points by description

Jeff_M — Thu, 26 May 2022 04:06:25 GMT

You didn't include 2 helper functions so cannot test what you posted.

Re: Lisp Routine for Connecting civil Points by description

RickfromtheNorth — Thu, 26 May 2022 15:00:26 GMT

Sorry Here is all the code. Re-worked a bit I'm getting an error

** Error: no function definition: ENAME->VLA ** I'm using 2021 C3D

Thanks

(defun c:JoinByDescription (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **"))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ)) ;;-----------;; ;; Main Code ;; ;;-----------;; (setq descEnt (car (entsel "\nPick Cogo Point for description to filter by:"))) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:EntmakeLWPoly locs2d) (*error* nil)) (defun c:JoinByDescription3D (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **"))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ)) ;;-----------;; ;; Main Code ;; ;;-----------;; (setq descEnt (car (entsel "\nPick Cogo Point for description to filter by:"))) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:Entmake3dpoly locs3d) (*error* nil)) (defun c:JoinBySelection (/ *error* LOCS2D LOCS3D OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **"))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ)) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ssget '((0 . "AECC_COGO_POINT")))) (if ss (progn (setq objs (ENAME->VLA ss)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:EntmakeLWPoly locs2d))) (*error* nil)) ;; (defun c:JoinBySelection3D (/ *error* LOCS2D LOCS3D OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **"))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ)) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ssget '((0 . "AECC_COGO_POINT")))) (if ss (progn (setq objs (ENAME->VLA ss)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:Entmake3dpoly locs3d))) (*error* nil)) ;;; (defun c:JoinByDescSel3D (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))) (princ (strcat "\n** Error: " msg " **"))) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ)) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ENAME->VLA (ssget '((0 . "AECC_COGO_POINT"))))) (setq descEnt (car (entsel "\nPick Cogo Point for description to filter by:"))) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) ;;; (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (JP:Entmake3dpoly locs3d) (*error* nil)) ;;; (defun JP:EntmakeLWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst))) (mapcar (function (lambda (p) (cons 10 p))) lst)))) ;; (defun JP:Entmake3dpoly (lst) (entmake (list (cons 0 "POLYLINE") (cons 66 1) (cons 100 "AcDb3dPolyline") '(70 . 8))) (foreach pt lst (entmake (list (cons 0 "VERTEX") '(100 . "AcDb3dPolylineVertex") '(70 . 32) (cons 10 pt)))) (entmake '((0 . "SEQEND")))) ;; (defun JP:CogoNumberComparer (o1 o2 /) (< (vlax-get o1 'NUMBER) (vlax-get o2 'NUMBER))) ;; (defun JP:FilterCogoByRawDescription (objs rawDesc / C FILTERED) (foreach obj objs (if (and (not (vl-catch-all-error-p (setq c (vl-catch-all-apply 'vlax-get-property (list obj 'RawDescription))))) (wcmatch c rawDesc)) (setq filtered (append filtered (list obj))))) filtered) ;; ;;;(defun FilterCogoByRawDescription (ss rawDesc / ADD E I O SS) ;;; (setq add (ssadd)) ;;; (repeat (setq i (sslength ss)) ;;; (setq e (ssname ss (setq i (1- i))) ;;; o (vlax-ename->vla-object e)) ;;; (if ;;; (vl-some ;;; '(lambda (prop / c) ;;; (and (not (vl-catch-all-error-p ;;; (setq c (vl-catch-all-apply 'vlax-get-property (list o prop))))) ;;; (wcmatch (strcase c) rawDesc))) ;;; '(RawDescription)) ;;; (ssadd e add))) ;;; (ename->vla add)) ;;; ;;; ;;; ;;;(setq objs (ENAME->VLA (ssget))) ;;; ;;; ;;;(FILTERCOGOBYRAWDESCRIPTION objs "BUSH-LINE-6") ;;; ;;; ;;; ;;;(defun rtp (/ LOCS2D LOCS3D OBJS SS) ;;; (setq ss (ssget '((0 . "AECC_COGO_POINT")))) ;;; (setq objs (ENAME->VLA ss)) ;;; (setq objs (vl-sort objs 'CogoNumberComparer)) ;;; (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;;;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x))) locs3d)) ;;; (foreach loc locs3d ;;; (setq loctxt (mapcar '(lambda (x) (rtos x 2 3)) loc)) ;;;;;; (setq txt (strcat (car loctxt) "," (cadr loctxt) "," (caddr loctxt) " ")) ;;; (setq txt (strcat (car loctxt) "," (cadr loctxt) " ")) ;;; (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) txt))) ;;; ;;;(vlax-add-cmd "rtp" 'rtp "rtp" ACRX_CMD_TRANSPARENT) ;;; ;;; ;;;(vlax-add-cmd "rtp" 'rtp "rtp" ACRX_CMD_TRANSPARENT) ;;; ;;; ;;;(command pt) ;;; ;;;(setq pts (list (getpoint) (getpoint))) ;;; ;;;(defun IssuePointAsCommand (pt) ;;; (setq loctxt (mapcar '(lambda (x) (rtos x 2 16)) loc)) ;;; (setq txt (strcat (car loctxt) "," (cadr loctxt) " ")) ;;; (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) txt)

Re: Lisp Routine for Connecting civil Points by description

Jeff_M — Thu, 26 May 2022 19:17:00 GMT

I added the ENAME->VLA function and made a few tweaks to the first (defun c:) which now works. I did not test the other (defun c:)'s.

(defun c:JoinByDescription (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) (princ (strcat "\n** Error: " msg " **")) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) ) ;;-----------;; ;; Main Code ;; ;;-----------;; (setq descEnt (entsel "\nPick Cogo Point for description to filter by:") ) (setq obj (ENAME->VLA (car descEnt))) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (JP:EntmakeLWPoly locs2d) (*error* nil) ) (defun c:JoinByDescription3D (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) (princ (strcat "\n** Error: " msg " **")) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) ) ;;-----------;; ;; Main Code ;; ;;-----------;; (setq descEnt (car (entsel "\nPick Cogo Point for description to filter by:") ) ) (setq obj (ENAME->VLA descEnt)) (setq flt (vlax-get obj 'RAWDESCRIPTION)) (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (JP:Entmake3dpoly locs3d) (*error* nil) ) (defun c:JoinBySelection (/ *error* LOCS2D LOCS3D OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) (princ (strcat "\n** Error: " msg " **")) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) ) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ssget '((0 . "AECC_COGO_POINT")))) (if ss (progn (setq objs (ENAME->VLA ss)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (JP:EntmakeLWPoly locs2d) ) ) (*error* nil) ) ;; (defun c:JoinBySelection3D (/ *error* LOCS2D LOCS3D OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) (princ (strcat "\n** Error: " msg " **")) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) ) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ssget '((0 . "AECC_COGO_POINT")))) (if ss (progn (setq objs (ENAME->VLA ss)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (JP:Entmake3dpoly locs3d) ) ) (*error* nil) ) ;;; (defun c:JoinByDescSel3D (/ *error* DESCENT FLT LOCS2D LOCS3D OBJ OBJS SS) ;;---------------------;; ;; Local Error Handler ;; ;;---------------------;; (defun *error* (msg) (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) ) (princ (strcat "\n** Error: " msg " **")) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (princ) ) ;;-----------;; ;; Main Code ;; ;;-----------;; (princ "\nSelect Cogo Points join:") (setq ss (ENAME->VLA (ssget '((0 . "AECC_COGO_POINT"))))) (setq descEnt (entsel "\nPick Cogo Point for description to filter by:") ) (setq obj (ENAME->VLA (car descEnt))) (setq flt (vlax-get obj 'RAWDESCRIPTION)) ;;; (setq ss (ENAME->VLA (ssget "_A" '((0 . "AECC_COGO_POINT"))))) (setq objs (JP:FilterCogoByRawDescription ss flt)) (setq objs (vl-sort objs 'JP:CogoNumberComparer)) (setq locs3d (mapcar '(lambda (x) (vlax-get x 'LOCATION)) objs)) ;;; (setq locs2d (mapcar '(lambda (x) (list (car x) (cadr x) 0.0)) locs3d)) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)) ) (JP:Entmake3dpoly locs3d) (*error* nil) ) ;;; (defun JP:EntmakeLWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) ;; (defun JP:Entmake3dpoly (lst) (entmake (list (cons 0 "POLYLINE") (cons 66 1) (cons 100 "AcDb3dPolyline") '(70 . 8) ) ) (foreach pt lst (entmake (list (cons 0 "VERTEX") '(100 . "AcDb3dPolylineVertex") '(70 . 32) (cons 10 pt) ) ) ) (entmake '((0 . "SEQEND"))) ) ;; (defun JP:CogoNumberComparer (o1 o2 /) (< (vlax-get o1 'NUMBER) (vlax-get o2 'NUMBER)) ) ;; (defun JP:FilterCogoByRawDescription (objs rawDesc / C FILTERED) (foreach obj objs (if (and (not (vl-catch-all-error-p (setq c (vl-catch-all-apply 'vlax-get-property (list obj 'RawDescription) ) ) ) ) (wcmatch c rawDesc) ) (setq filtered (append filtered (list obj))) ) ) filtered ) (defun ENAME->VLA (ss) (cond ((= (type ss) 'PICKSET) (setq idx -1) (while (setq ent (ssname ss (setq idx (1+ idx)))) (setq objs (cons (vlax-ename->vla-object ent) objs)) ) ) ((= (type ss) 'ENAME) (setq objs (vlax-ename->vla-object ss)) ) (t (setq objs nil)) ) objs )

Re: Lisp Routine for Connecting civil Points by description

RickfromtheNorth — Thu, 26 May 2022 22:49:44 GMT

I get this error now.

** Error: bad argument type: consp #<VLA-OBJECT IAeccPoint 000001fc50311c80> **

Re: Lisp Routine for Connecting civil Points by description

Jeff_M — Thu, 26 May 2022 23:30:37 GMT

When do you get that? The first time run? Second time? Which command?

I did notice I didn't localize the variables:

(defun ENAME->VLA (ss / objs idx ent) (cond ((= (type ss) 'PICKSET) (setq idx -1) (while (setq ent (ssname ss (setq idx (1+ idx)))) (setq objs (cons (vlax-ename->vla-object ent) objs)) ) ) ((= (type ss) 'ENAME) (setq objs (vlax-ename->vla-object ss)) ) (t (setq objs nil)) ) objs )

Re: Lisp Routine for Connecting civil Points by description

RickfromtheNorth — Fri, 27 May 2022 14:24:55 GMT

I ran Joinpointsbydescription and got it right away after selecting the cogo point. Even with this new Defun I get the same error. Joinbyselection commands do work. It's just the joinbydescription and joinbydescription3d that do not work.

Re: Lisp Routine for Connecting civil Points by description

Jeff_M — Fri, 27 May 2022 15:46:07 GMT

Are you using the full code I posted? I just ran all 5 of the JoinBy* commands and had no issues:

Command: JOINBYDESCRIPTION

Pick Cogo Point for description to filter by:
Command:
Command: JOINBYDESCRIPTION3D

Pick Cogo Point for description to filter by:
Command:
Command: JOINBYDESCSEL3D

Select Cogo Points join:
Select objects: Specify opposite corner: 20 found

Select objects:
Pick Cogo Point for description to filter by:

Command:
Command: JOINBYSELECTION

Select Cogo Points join:
Select objects: Specify opposite corner: 25 found

Select objects:

Command:
Command: JOINBYSELECTION3D

Select Cogo Points join:
Select objects: Specify opposite corner: 9 found

Select objects:

Command:

Re: Lisp Routine for Connecting civil Points by description

RickfromtheNorth — Fri, 27 May 2022 16:04:44 GMT

That's the ticket, all works now. Thanks a bunch Jeff your the best.