Jump to content

LISP Routine Help


tjjackson

Recommended Posts

We design overhead power lines and part of our daily routine is to draw miles and miles of pole blocks connected by separate polylines. We currently run a LISP routine to automatically place the pole blocks at the corresponding gps point, based on a feature code. Is there a way to automatically draw the polylines between these blocks. The blocks have pole/previous pole attributes built in to them. Also, can dimension text for each span be added as the lines are drawn? Finally, can angular dimensions be added at each pole location in a separate layer? I'm a rookie with lisp, but have been using AutoCAD for 18 years. I'm willing to learn all I can. Any help would be greatly appreciated.

Link to comment
Share on other sites

  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • tjjackson

    12

  • Stefan BMR

    5

  • jonathann3891

    4

  • JSYoung81

    2

I'm using Lee Mac's point manager for the insertion of poles. Here is an image of a drawing and an image of our attribute fields.

attributes2.jpg

poles 2.jpg

Link to comment
Share on other sites

What about a point file?

 

An easy way to accomplish this without any lisp is to do the following:

 

If your using a csv to import the points:

 

Add PLINE, LINE, or whatever you want to use at the top

Save as a script (.scr) file type.

 

In autocad type SCR at the command line and path to the script.

 

If your using excel:

Export as a csv

Add PLINE, LINE, or whatever you want to use at the top

 

Save as a script.

 

Make sure all your points have a point number or it may not work correctly.

Link to comment
Share on other sites

I was hoping to filter all polylines, select the ones I need dimensioned and add a text box at the midpoint of the line on the zero plane. I could then move the text boxes adjacent to the line as needed. Thanks for your help. I have then script working great now.

Link to comment
Share on other sites

;;; THIS LISP WILL TAKE A LINE ON AN EXPLOPED
;;; PROFILE AND CALCULATE THE SLOPE
;;;
;;; THE LISP WILL ASK THE USER FOR THE RATIO
;;; OF THE PROFILE IN QUESTION (IE: 10:1 , ]
;;; 5:1 AND SO ON).
;;;
;;; NEXT THE USER WILL SELECT THE LINE IN QUESTION
;;; AND WILL PLACE THE SLOPE ON THE LINE AT THE MID-POINT
;;;
;;;
;;;   This program is free software: you can redistribute it and/or modify
;;;    it under the terms of the GNU General Public License as published by
;;;    the Free Software Foundation, either version 3 of the License, or
;;;    (at your option) any later version.
;;;
;;;    This program is distributed in the hope that it will be useful,
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;    GNU General Public License for more details.
;;;
;;;    You should have received a copy of the GNU General Public License
;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;;
;;;
;;; SLOPELINE.LSP - COPYRIGHT 2014 BY J. SHAWN YOUNG
;;;
;;;
;;; VERSION 1.0 - INITIAL STATE
;;;
;;; VERSION 2.0 2014-11-26
;;;		- RE-WROTE LISP TO BE MORE EFFICENT
;;;		- NO MORE NEGITIVE SLOPES
;;;		- ALLOW FOR SELECTION SETS OF LINES AND POLYLINES
;;;
;;; VERSION 2.1 2014-11-26
;;;		- FIXED ISSUED WITH TEXT COMING IN UPSIDE DOWN
;;;		IF LINE WAS DRAWN RIGHT TO LEFT
;;;
;;;
;;;
;;;

(DEFUN C:SLOPELINE (/      PT1    PT2    PT1_Y  PT1_X  PT2_Y	 PT2_X	RATIO
       SSET   OBJ    RISE   RUN	   SLOPE  MIDPOINT	ANG
       ANG2   LEN    LST    COUNT  LAYER  ITEM	 COUNT	CHECK
       N STYTEXT len2
      )
 (vl-load-com)

;;;		SELECTION SET		;;;

 (SETQ	SSET				;BEGIN SETQ
 (SSGET				;BEGIN SSGET
   '(
     (-4 . "<XOR")		;BEGIN XOR
     (0 . "LWPOLYLINE")		;GET POLYLINE
     (0 . "LINE")		;GET LINE
     (-4 . "XOR>")		;END XOR
    )
 )				;END SSGET
 )					;END SETQ
 (SETQ					;BEGIN SETQ
   COUNT (SSLENGTH SSET)		;SET COUNT TO SELECTION SET LENGTH
   N	  0				;N TO 0
   RATIO 1
 )					;END SETQ

;;;	CHECK AND SET TEXT STYLE	;;;

 (COMMAND "CMDECHO" 0)			;ECHO OFF

 (setq stytext (tblsearch "style" "AE-25")) ;SEARCH FOR AE-25
 (if					;BEGINS PROCESS FOR MAKING AE-25
   (or
     (= NIL stytext)
     (/= (cdr (assoc 40 stytext)) 0.0)
   )
    (command "-style" "AE-25" "arial" "a" "y" "N" "2.5" "1.0" "0" "n"
      "n")
 )					;END IF

;;;	CHECK AND SET TEXT STYLE	;;;

 (SETQ LAYER (TBLSEARCH "LAYER" "C-ANNO-TEXT"))
 (IF
   (= NIL LAYER)
    (COMMAND "-LAYER" "N" "C-ANNO-TEXT" "S" "C-ANNO-TEXT" "C" "2" "" "")
 )

 (IF
   (/= LAYER NIL)
    (COMMAND "-LAYER" "S" "C-ANNO-TEXT" "")
 )

;;;	BEGIN MAIN FUNCTION		;;;

 (WHILE				;BEGIN IF
   (> COUNT N)				;LOGIC STATEMENT

    (PROGN				;BEGIN PROGN

      (SETQ				;BEGIN SETQ
 OBJ   (SSNAME SSET N)		;GET NEXT OBJECT IN SELECTION SET
 OBJ   (VLAX-ENAME->VLA-OBJECT OBJ) ;CONVERT
 check (vlax-get obj 'objectname) ;get object name
 len   (vla-get-length obj)
 len2   (/ len 2)
      )				;END SETQ

      (IF				;BEGIN IF FOR LINE
 (= CHECK "AcDbLine")		;LOGIC STATEMENT
  (progn
    (setq
      ITEM (ENTGET (SSNAME SSET N))
      PT1  (CDR (ASSOC 10 ITEM))
      PT2  (CDR (ASSOC 11 ITEM))
    )

  )
      )				;END IF FOR LINE

      (IF				;BEGIN IF FOR POLYLINE
 (= CHECK "AcDbPolyline")	;LOGIC STATEMENT
  (setq				;BEGIN SETQ
    lst	(vlax-get OBJ 'coordinates) ;GETS COORDINATES
    LEN	(VLA-GET-LENGTH OBJ)	;GET LENGTH
    LEN2(/ LEN 2)		;HALVE THE LENGTH
    pT1	(list (car lst) (cadr lst)) ;GETS START POINT
    lst	(reverse lst)		;REVERSE LIST
    pT2	(list (cadr lst) (car lst)) ;GETS END POINT
  )
      )				;END IF POLYLINE

      (setq
 ANG   (ANGLE PT1 PT2)		;GET ANGLE IN RADS
 ANG2  (/ (* ANG 180) PI)	;CONVERTS ANGLE TO DEGREES
 PT1_X (CAR PT1)		;GETS X OF START POINT
 PT1_Y (CADR PT1)		;GETS Y OF START POINT
 PT2_X (CAR PT2)		;GETS X OF END POINT
 PT2_Y (CADR PT2)		;GETS Y OF END POINT
 RUN   (- PT2_X PT1_X)		;GETS RUN
 RISE  (/ (- PT2_Y PT1_Y) RATIO)
				;GETS RISE AND DIVIDES BY RATIO
      )				;END SETQ



      (IF (> 0 RUN)			;BEGIN IF
 (SETQ RUN (* RUN -1))		;IF RUN IS NEGITIVE TURN POSITIVE
      )				;END IF

      (IF (> 0 RISE)			;BEGIN IF
 (SETQ RISE (* RISE -1))	;IF RUN IS NEGITIVE TURN POSITIVE
      )				;END IF

      (SETQ				;BEGIN SETQ
 SLOPE (* (/ RISE RUN) 100)	;GETS SLOPE
      )
      (IF (> 0 SLOPE)			;BEGIN IF
 (SETQ SLOPE (* SLOPE -1))	;IF RUN IS NEGITIVE TURN POSITIVE
      )				;END IF

      (SETQ
 MIDPOINT (POLAR PT1 ANG LEN2)

      )				;END SETQ
(if
 (< PT2_X PT1_X)
 (SETQ ANG2 (- ANG2 180)
))


      (COMMAND "_TEXT" "J" "BC" MIDPOINT ANG2 ( RTOS len 2 3))
      (SETQ N (+ 1 N))			;INCREASE N BY 1
    )					;END PROGN


 )					;END IF






 (COMMAND "CMDECHO" 1)

 (PRINC)
)
;END DEFUN

 

I wrote this to give slopes on expolded profiles. Modded it so that it will give you distance.

Link to comment
Share on other sites

Awesome! Thanks for your help.

Is there a way to change the text orientation, text style, size and precision? Our standard for these drawings are zero rotation and rounded to the nearest foot. (Ex: 232')

Link to comment
Share on other sites

Makes changes to here for your text style and layer

;;;	CHECK AND SET TEXT STYLE	;;;

 (COMMAND "CMDECHO" 0)			;ECHO OFF

 (setq stytext (tblsearch "style" "AE-25")) ;SEARCH FOR AE-25
 (if					;BEGINS PROCESS FOR MAKING AE-25
   (or
     (= NIL stytext)
     (/= (cdr (assoc 40 stytext)) 0.0)
   )
    (command "-style" "AE-25" "arial" "a" "y" "N" "2.5" "1.0" "0" "n"
      "n")
 )					;END IF
;;;	CHECK AND SET TEXT STYLE	;;;

 (SETQ LAYER (TBLSEARCH "LAYER" "C-ANNO-TEXT"))
 (IF
   (= NIL LAYER)
    (COMMAND "-LAYER" "N" "C-ANNO-TEXT" "S" "C-ANNO-TEXT" "C" "2" "" "")
 )

 (IF
   (/= LAYER NIL)
    (COMMAND "-LAYER" "S" "C-ANNO-TEXT" "")

 

makes changes here for your rotation and percision

 

(if
 (< PT2_X PT1_X)
 (SETQ ANG2 (- ANG2 180)
))


      (COMMAND "_TEXT" "J" "BC" MIDPOINT [b]ANG2[/b] ( RTOS len 2 [b]3[/b]))
      (SETQ N (+ 1 N))			;INCREASE N BY 1
    )					;END PROGN


 )					;END IF

 

change ang2 to your rotation angle, and change 3 to 0 set your percision.

Link to comment
Share on other sites

...Is there a way to automatically draw the polylines between these blocks. The blocks have pole/previous pole attributes built in to them. Also, can dimension text for each span be added as the lines are drawn?...

Hi tj

 

Here is a lisp to draw LINES between every possible pair pole-pevious_pole.

It also write the length of each line next to it; the number represent the real length of the line in 3D. It works on your drawing, exploded once, so each pole is an independent block.

It uses lines because the blocks are at a specific elevation so a polyline could be possible only projected into a plane, say z=0. Even so, it would be hard to find the correct sequence of the poles as there are many intersections, the pole's numbering is not in a clear order and it uses an alpha-numerical system, which makes it even harder to sort.

The text, representing line's length... I'm not familiar with imperial units so the text height is hard coded (5 units, like the text I found in your dwg). I can change it if your text height depend on a particular setting (like ltscale, dimscale, annotation scale etc.).

 

(defun c:pole_line ( / *error* acDoc ms ht ss i e p a pn pp pole_list prev_list p1 p2 pt txt)
 (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
;;;  (setq ht (/ (if (zerop (getvar 'measurement)) 0.1 2.5) (cond ((getvar 'cannoscalevalue)) (1.0))))
 (setq ht 5.0)
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     )
   (vla-endundomark acDoc)
   (princ)
   )
 
 (if
   (setq ss (ssget '((0 . "INSERT"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
             p (vlax-get e 'InsertionPoint)
             a (vlax-invoke e 'GetAttributes)
             pn nil pp nil
             )
       (foreach x a
         (cond
           ((eq (vla-get-tagstring x) "POLE_NUM")
            (setq pn (vla-get-textstring x))
            )
           ((eq (vla-get-tagstring x) "PREV_POLE")
            (setq pp (vla-get-textstring x))
            )
           )
         )
       (if pn (setq pole_list (cons (list pn pp p) pole_list))
         (if pp (setq prev_list (cons (list pp p) prev_list)))
         )
       )
     (foreach p2 pole_list
       (if
         (or
           (setq p1 (assoc (cadr p2) pole_list))
           (setq p1 (assoc (cadr p2) prev_list))
           )
         (progn
           (setq p1 (last p1) p2 (last p2)
                 a  (angle p1 p2)
                 a  (if (< (* pi 0.5) a (* pi 1.25)) (- a (/ pi 2.0)) (+ a (/ pi 2.0)))
                 pt (polar (mapcar '(lambda (a b) (* (+ a b) 0.5)) p1 p2) a (* ht 2.0))
                 )
           (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
           (setq txt (vla-addtext ms (rtos (distance p1 p2) 2 0) (vlax-3D-point 0.0 0.0 0.0) ht))
           (vla-put-alignment txt acalignmentmiddlecenter)
           (vla-put-textalignmentpoint txt (vlax-3D-point pt))
         )
       )
     )
   )
 )
 (vla-endundomark acDoc)
 (princ)
)

Link to comment
Share on other sites

Stefan,

 

 

That is unbelievable. It works great. Can you change it to draw polylines and measure 2D points? We are measuring span lengths and need the 2D distance.If the linewidth can be 1,that would be great. Also, can we change the text size to 10 and add the ft mark (') suffix? If not, can the text be changed to dimension text and I can add the ft mark with dimstyle?

 

 

Thank you so much for your help. This will save so much time.

Link to comment
Share on other sites

Stefan,

That is unbelievable. It works great.

...

Thank you so much for your help. This will save so much time.

You're welcome tj.

 

...Can you change it to draw polylines and measure 2D points? We are measuring span lengths and need the 2D distance.If the linewidth can be 1,that would be great. Also, can we change the text size to 10 and add the ft mark (') suffix? If not, can the text be changed to dimension text and I can add the ft mark with dimstyle.

The text height and the ft mark you can consider done.

My previous post explain why I use lines. However, I can switch to polylines, at 0.0 elevation, but only 1 segment each (means they are not connected in a single object). Is that good for you?

Link to comment
Share on other sites

Perfect. Yes, please switch to polylines. We would rather them be individual segments rather than one entity. Thanks again for your help.

Link to comment
Share on other sites

Here it is...

(defun c:pole_line ( / *error* acDoc ms ht ss i e p a pn pp pole_list prev_list p1 p2 pt txt)
 (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq ms (getvar 'ctab))
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
     )
   (vla-endundomark acDoc)
   (princ)
   )
 
 (if
   (setq ss (ssget '((0 . "INSERT"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
             p (reverse (cdr (reverse (vlax-get e 'InsertionPoint))))
             a (vlax-invoke e 'GetAttributes)
             pn nil pp nil
             )
       (foreach x a
         (cond
           ((eq (vla-get-tagstring x) "POLE_NUM")
            (setq pn (vla-get-textstring x))
            )
           ((eq (vla-get-tagstring x) "PREV_POLE")
            (setq pp (vla-get-textstring x))
            )
           )
         )
       (if pn (setq pole_list (cons (list pn pp p) pole_list))
         (if pp (setq prev_list (cons (list pp p) prev_list)))
         )
       )
     (foreach p2 pole_list
       (if
         (or
           (setq p1 (assoc (cadr p2) pole_list))
           (setq p1 (assoc (cadr p2) prev_list))
           )
         (progn
           (setq p1 (last p1) p2 (last p2)
                 a  (angle p1 p2)
                 a  (if (< (* pi 0.5) a (* pi 1.25)) (- a (/ pi 2.0)) (+ a (/ pi 2.0)))
                 pt (polar (mapcar '(lambda (a b) (* (+ a b) 0.5)) p1 p2) a 15.0)
                 )
           (entmake
             (list
               '(0 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               (cons 410 ms)
               '(100 . "AcDbPolyline")
               '(90 . 2)
               '(70 . 0)
               (cons 10 p1)
               '(40 . 1.0)
               '(41 . 1.0)
               (cons 10 p2)
               '(40 . 1.0)
               '(41 . 1.0)
               '(210 0.0 0.0 1.0)
             )
           )
           (entmake
             (list
               '(0 . "TEXT")
               '(100 . "AcDbEntity")
               (cons 410 ms)
               '(100 . "AcDbText")
               (cons 10 pt)
               '(40 . 10.0)
               (cons 1 (strcat (rtos (distance p1 p2) 2 0) "'"))
               '(50 . 0.0)
               (cons 7 (getvar "textstyle"))
               '(72 . 1)
               (cons 11 pt)
               '(73 . 2)
             )
           )
         )
       )
     )
   )
 )
 (vla-endundomark acDoc)
 (princ)
)

 

Waiting for comments, TJ...

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
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.


×
×
  • Create New...