Find nearest polyline, create new vertex and extract Object Data

February 1, 2018

Hi all,

I'm trying write a LISP routine which will accomplish the following:

1. Select the block reference on the drawing

2. Find the closest polyline and closest point on that polyline from this block reference

3. Create vertex on that point and save the coordinates of this point into a variable for further use

4. Extract Object Data such as SerialNo (please refer to the screenshot attached) from that block reference

5. Loop for each block reference

6. Export the point's coordinates saved earlier and its corresponding SerialNo into txt or csv which will look like:

X_coord, Y_coord, SerialNo

E.g. 85.4535, 18.7903, 09I4E5Q2104022719

or 85.4535, 18.7903, 09I4E5Q2104022311, 09I4E5Q2104022719 (if it has more than one block reference)

The output file is interpreted as the electric line having the load on that particular point.

Here's what I have found/borrowed so far which can be of help:

For creating vertex program provided by DEVITG at this thread

;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2018 by Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM    

; Hecho por  Gabo CALOS DE VIT de CORDOBA ARGENTINA
;;;    Copyleft 1995-2018 por Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM 
; no error check.
;; no nothing 

(vl-load-com)
(DEFUN C:EXAMPLE_ADDVERTEX  ( /
ACADOBJ
BLK-REF-XYZ
BLK-REFERENCE
DOC
LSTPOINT
MODELSPACE
NEWVERTEX
PARAM-AT-CLOSEST-POINT
PLINE
PLINE-OBJ
POINT-AT-PARAM
VERTEX-POINT


                            )

 (SETQ ACADOBJ (VLAX-GET-ACAD-OBJECT))
 (SETQ DOC (VLA-GET-ACTIVEDOCUMENT ACADOBJ))
 (SETQ MODELSPACE (VLA-GET-MODELSPACE DOC))

 (SETQ PLINE (ENTSEL "\nSelect Polyline: "))
 (SETQ PLINE-OBJ (VLAX-ENAME->VLA-OBJECT (CAR PLINE)))

 (SETQ BLK-REFERENCE (CAR (ENTSEL "\Select the block-reference")))
 (SETQ BLK-REF-XYZ (CDR (ASSOC 10 (ENTGET BLK-REFERENCE))))
;;;  (VL-CMDF "POINT" BLK-REF-XYZ "")
 (SETQ LSTPOINT (VLAX-CURVE-GETCLOSESTPOINTTO PLINE-OBJ BLK-REF-XYZ))

 (SETQ PARAM-AT-CLOSEST-POINT (VLAX-CURVE-GETPARAMATPOINT PLINE-OBJ LSTPOINT))
 (SETQ POINT-AT-PARAM (VLAX-CURVE-GETPOINTATPARAM PLINE-OBJ PARAM-AT-CLOSEST-POINT))
 (SETQ VERTEX-POINT (LIST (CAR POINT-AT-PARAM) (CADR POINT-AT-PARAM)))
;;;  (VL-CMDF "POINT" VERTEX-POINT "")

 (SETQ NEWVERTEX (VLAX-MAKE-SAFEARRAY VLAX-VBDOUBLE '(0 . 1)))
 (VLAX-SAFEARRAY-FILL NEWVERTEX VERTEX-POINT)

 (VLA-ADDVERTEX PLINE-OBJ (1+ (FIX PARAM-AT-CLOSEST-POINT)) NEWVERTEX)
 (VLA-UPDATE PLINE-OBJ)
 )

It works good but now it needs to be modified to work in a loop

For extracting Object Data the answer provided by BlackBox at this thread might be helpful

The Sample Drawing is attached

I would appreciate your help

Thank you

Regards,

Jes G

Sample_Drawing.dwg

February 2, 2018

jes_g ,

Here is my Friday afternoon attempt.

Assumes your data (Serial Number?) is contained in an attribute in each block;

The first attribute value (Serial Number) is extracted;

1 Select the Polyline; then

2 Select the Blocks.

A POINT will be placed (on the selected Polyline) at the nearest point to each block; and

Data will be saved to a CSV file

(defun C:ODATA (/ pl s fn opn i e de dp )
 (vl-load-com)

 (setvar 'pdmode 3)


     (while
(progn
  (setvar 'errno 0)
  (setq pl
  (car (entsel "\nSelect Polyline: ")
  ) ;_ end of car
  ) ;_ end of setq
  (cond
    ((= 7 (getvar 'errno))
     (princ "\nMissed, Please Try Again.")
    )
    ((/= "LWPOLYLINE" (cdr (assoc 0 (entget pl))))
     (princ
       "\nThe Selected Entity is not a LWPOLYLINE."
     ) ;_ end of princ
    )
  ) ;_ end of cond
) ;_ end of progn
     ) ;_ end of while

(prompt "\nSelect **Attributed** Blocks to Process: ")

 (if (and (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (setq fn (getfiled "Save Block Data to CSV File"
        (vl-filename-base (getvar 'dwgname))
        "csv"
        1
     ) ;_ end of getfiled
   ) ;_ end of setq
   (setq opn (open fn "w"))
     ) ;_ end of and
  
   (progn
     (write-line
(strcat
  "SERIAL NUMBER (ATTRIBUTE)"
  ","
  "ELEC LINE VERTEX EASTING"
  ","
  "ELEC LINE VERTEX NORTHING"
  ","
  "BLOCK INSERTION EASTING"
  ","
  "BLOCK INSERTION NORTHING"
    ) ;_ end of strcat
    opn
  ) ;_ end of write-line
  
     (close opn)
     (setq opn (open fn "a"))
     (repeat (setq i (sslength s))
(setq e (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(setq
  de (vlax-get e 'insertionpoint)
  dp (vlax-curve-getclosestpointto pl de)
) ;_ end of setq
(vl-cmdf "_.point" dp "")
(write-line
  (strcat
    (vla-get-textstring (car (vlax-invoke e 'getattributes)))
    ","
    (rtos (car dp) 2 4)
    ","
    (rtos (cadr dp) 2 4)
    ","
    (rtos (car de) 2 4)
    ","
    (rtos (cadr de) 2 4)
  ) ;_ end of strcat
  opn
) ;_ end of write-line
     ) ;_ end of repeat
   ) ;_ end of progn
 ) ;_ end of if
 (close opn)
 (princ)
) ;_ end of defun

I am no expert but hopefully this will move you closer to your desired solution.

Cheers

ODATA.lsp

February 2, 2018

jes_g ,

Here is my Friday afternoon attempt.

Assumes your data (Serial Number?) is contained in an attribute in each block;

The first attribute value (Serial Number) is extracted;

1 Select the Polyline; then

2 Select the Blocks.

A POINT will be placed (on the selected Polyline) at the nearest point to each block; and

Data will be saved to a CSV file

(defun C:ODATA (/ pl s fn opn i e de dp )
 (vl-load-com)

 (setvar 'pdmode 3)


     (while
(progn
  (setvar 'errno 0)
  (setq pl
  (car (entsel "\nSelect Polyline: ")
  ) ;_ end of car
  ) ;_ end of setq
  (cond
    ((= 7 (getvar 'errno))
     (princ "\nMissed, Please Try Again.")
    )
    ((/= "LWPOLYLINE" (cdr (assoc 0 (entget pl))))
     (princ
       "\nThe Selected Entity is not a LWPOLYLINE."
     ) ;_ end of princ
    )
  ) ;_ end of cond
) ;_ end of progn
     ) ;_ end of while

(prompt "\nSelect **Attributed** Blocks to Process: ")

 (if (and (setq s (ssget "_:L" '((0 . "INSERT") (66 . 1))))
   (setq fn (getfiled "Save Block Data to CSV File"
        (vl-filename-base (getvar 'dwgname))
        "csv"
        1
     ) ;_ end of getfiled
   ) ;_ end of setq
   (setq opn (open fn "w"))
     ) ;_ end of and
  
   (progn
     (write-line
(strcat
  "SERIAL NUMBER (ATTRIBUTE)"
  ","
  "ELEC LINE VERTEX EASTING"
  ","
  "ELEC LINE VERTEX NORTHING"
  ","
  "BLOCK INSERTION EASTING"
  ","
  "BLOCK INSERTION NORTHING"
    ) ;_ end of strcat
    opn
  ) ;_ end of write-line
  
     (close opn)
     (setq opn (open fn "a"))
     (repeat (setq i (sslength s))
(setq e (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(setq
  de (vlax-get e 'insertionpoint)
  dp (vlax-curve-getclosestpointto pl de)
) ;_ end of setq
(vl-cmdf "_.point" dp "")
(write-line
  (strcat
    (vla-get-textstring (car (vlax-invoke e 'getattributes)))
    ","
    (rtos (car dp) 2 4)
    ","
    (rtos (cadr dp) 2 4)
    ","
    (rtos (car de) 2 4)
    ","
    (rtos (cadr de) 2 4)
  ) ;_ end of strcat
  opn
) ;_ end of write-line
     ) ;_ end of repeat
   ) ;_ end of progn
 ) ;_ end of if
 (close opn)
 (princ)
) ;_ end of defun

I am no expert but hopefully this will move you closer to your desired solution.

Cheers

Thank you for your response. I run this code and when I try to select block references they are not selected. Thank you

February 2, 2018

Here's a quick one to get you started. I've put comments so you can edit the code to suit your needs exactly.

(defun c:foo (/ _writefile d od out p p2 s s1 tmp x)
 ;; RJP - 2.2.2018
 (defun _writefile (file l / fo)
   (cond ((and (eq 'str (type file)) (setq fo (open file "w")))
   (foreach x l (write-line (vl-princ-to-string x) fo))
   (close fo)
   file
  )
   )
 )
 (if (= 'exrxsubr (type ade_odgettables))
   (if	(and ;; All the meters
     (setq s (ssget "_x" '((0 . "insert") (2 . "tempmeter"))))
     ;; All the lwpoly[line]s on layer *Phase
     (setq s1 (ssget "_x" '((0 . "lwpolyline,line") (8 . "*phase"))))
     ;; Convert block to list of enames
     (setq s (mapcar 'cadr (ssnamex s)))
     ;; Convert lwpoly[line]s to list of enames
     (setq s1 (mapcar 'cadr (ssnamex s1)))
)
     ;; For each meter
     (progn
(foreach b s
  ;; Get meter basepoint
  (setq p (cdr (assoc 10 (entget b))))
  ;; List of '((<closepoint> <distance> <ename>)...)
  (setq	d
	 (mapcar
	   '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) x))
	   s1
	 )
  )
  ;; Sort by closest distance and retrieve first item
  (setq d (car (vl-sort d '(lambda (r j) (< (cadr r) (cadr j))))))
  ;; Get serial number
  (setq od (ade_odgetfield b (car (ade_odgettables b)) "SerialNo" 0))
  ;; If the serial number is blank  change to "OHNOES!!!!!NoSerial!"
  (and (= "" od) (setq od "OHNOES!!!!!NoSerial!"))
  ;; Create point on closest pline
  (entmakex (list '(0 . "point") '(8 . "MeterClosePoint") (cons 10 (car d))))
  ;; Create line for visual check
  (entmakex (list '(0 . "line") '(8 . "Check") (cons 10 p) (cons 11 (car d))))
  ;; Create a vertex if it passes checks
  (and (= "LWPOLYLINE" (cdr (assoc 0 (entget (setq o (caddr d))))))
       (vlax-write-enabled-p (setq o (vlax-ename->vla-object o)))
       (setq i (vlax-curve-getparamatpoint o (setq p2 (car d))))
       (or (= 0 (fix i)) (/= 0 (rem (fix i) i)))
       (vlax-invoke o 'addvertex (1+ (fix i)) (list (car p2) (cadr p2)))
  )
  ;; Gather results
  (if (setq tmp (assoc (car d) out))
    ;; Point in list exists so append entry
    (setq out (subst (append tmp (list (strcat "," od))) tmp out))
    ;; New point just add item
    (setq out (cons (list (car d) od) out))
  )
)
;; Write file to current directory
(_writefile
  (strcat (getvar 'dwgprefix) "MeterStuff.csv")
  (mapcar
    '(lambda (x)
       (apply
	 'strcat
	 (append (mapcar '(lambda (y) (strcat (vl-princ-to-string y) ",")) (car x)) (cdr x))
       )
     )
    out
  )
)
     )
   )
   (print "Civil3D needed for this code...")
 )
 (princ)
)

Edited February 6, 2018 by ronjonp

February 2, 2018

Here's a quick one to get you started. I've put comments so you can edit the code to suit your needs exactly.

(defun c:foo (/ _writefile d od out p p2 s s1 tmp x)
 ;; RJP - 2.2.2018
 (defun _writefile (file l / fo result)
   (cond ((and (eq 'str (type file)) (setq fo (open file "w")))
   (foreach x l (write-line (vl-princ-to-string x) fo))
   (close fo)
   file
  )
   )
 )
 (if (and ;; All the meters
   (setq s (ssget "_x" '((0 . "insert") (2 . "tempmeter"))))
   ;; All the lwpoly[line]s on layer *Phase
   (setq s1 (ssget "_x" '((0 . "lwpolyline,line") (8 . "*phase"))))
   ;; Convert block to list of enames
   (setq s (mapcar 'cadr (ssnamex s)))
   ;; Convert lwpoly[line]s to list of enames
   (setq s1 (mapcar 'cadr (ssnamex s1)))
     )
   ;; For each meter
   (foreach b s
     ;; Get meter basepoint
     (setq p (cdr (assoc 10 (entget b))))
     ;; List of '((<closepoint> <distance> <ename>)...)
     (setq d
     (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) x))
	     s1
     )
     )
     ;; Sort by closest distance and retrieve first item
     (setq d (car (vl-sort d '(lambda (r j) (< (cadr r) (cadr j))))))
     ;; Get serial number
     (setq od (ade_odgetfield b (car (ade_odgettables b)) "SerialNo" 0))
     ;; If the serial number is blank  change to "OHNOES!!!!!NoSerial!"
     (and (= "" od) (setq od "OHNOES!!!!!NoSerial!"))
     ;; Create point on closest pline
     (entmakex (list '(0 . "point") '(8 . "MeterClosePoint") (cons 10 (car d))))
     ;; Create line for visual check
     (entmakex (list '(0 . "line") '(8 . "Check") (cons 10 p) (cons 11 (car d))))
     ;; Gather results
     (if (setq tmp (assoc (car d) out))
;; Point in list exists so append entry
(setq out (subst (append tmp (list (strcat "," od))) tmp out))
;; New point just add item
(setq out (cons (list (car d) od) out))
     )
   )
 )
 ;; Write file to current directory
 (_writefile
   (strcat (getvar 'dwgprefix) "MeterStuff.csv")
   (mapcar
     '(lambda (x)
 (apply	'strcat
	(append (mapcar '(lambda (y) (strcat (vl-princ-to-string y) ",")) (car x)) (cdr x))
 )
      )
     out
   )
 )
 (princ)
)

Wow! This looks perfect! Thanks!

The only thing I would need is creating new vertex on polyline where the closest point is as shown on the picture. How would you suggest to modify this?

Thank you. Your help is greatly appreciated

February 2, 2018

I updated the code .. give it a try. Remember to tip your waiter .

February 2, 2018

I updated the code .. give it a try. Remember to tip your waiter .

One last thing. Hope you're not fed up with this

How do you create new vertices on the polyline shown on the picture?

Thanks

February 2, 2018

Check your personal messages .. I already addressed that.

Sign In

Find nearest polyline, create new vertex and extract Object Data

Recommended Posts

jes_g

abra-CAD-abra

jes_g

ronjonp

jes_g

ronjonp

jes_g

ronjonp

Join the conversation

Tutorials

Forums

Activity