Jump to content

Find nearest polyline, create new vertex and extract Object Data


jes_g
 Share

Recommended Posts

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

OD_Block reference.jpg

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by ronjonp
Link to comment
Share on other sites

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?

new_vert.jpg

 

Thank you. Your help is greatly appreciated

Link to comment
Share on other sites

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

 

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

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

new_vert2.jpg

 

Thanks

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...