Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Lisp Modification Help

9 REPLIES 9
SOLVED
Reply
Message 1 of 10
Anonymous
745 Views, 9 Replies

Lisp Modification Help

 Hi all

I am using the following lisp, which extract X and Y coordinates from a polyline and print these to desired location. It will print different Y coordinates on same X distance. I want to print the decreasing Y coordinate away, the attached example drawing is shown. Anyone please modify this lisp.

Thanks in advance

 

 

AAK

;;; 12345678901234567890123456789012345678901234567890
;;; VERTEXT.LSP  A program to extract the xyz
;;; coordinates from any polyline and export them
;;; to an ascii file.

(defun ERR (S)
   (if (= S "Function cancelled")
      (princ "\nVERTEXT - cancelled: ")
      (progn (princ "\nVERTEXT - Error: ") (princ S) (terpri)) ;_ progn
   ) ; if
   (RESETTING)
   (princ "SYSTEM VARIABLES have been reset\n")
   (princ)
) ; err
(defun SETV (SYSTVAR NEWVAL)
   (setq X (read (strcat SYSTVAR "1")))
   (set X (getvar SYSTVAR))
   (setvar SYSTVAR NEWVAL)
) ; setv
(defun SETTING ()
   (setq OERR *ERROR*)
   (setq *ERROR* ERR)
   (SETV "CMDECHO" 0)
   (SETV "BLIPMODE" 0)
) ; end of setting
(defun RSETV (SYSTVAR) (setq X (read (strcat SYSTVAR "1"))) (setvar SYSTVAR (eval X)))
 ; restv
(defun RESETTING () (RSETV "CMDECHO") (RSETV "BLIPMODE") (setq *ERROR* OERR))
 ; end of resetting

(defun DXF (CODE ENAME) (cdr (assoc CODE (entget ENAME)))) ; dxf

(defun VERTEXT (/ EN VLIST)
   (setq EN (GET-EN))
   (if (= (DXF 0 EN) "LWPOLYLINE")
      (setq VLIST (GET-LWVLIST EN))
      (setq VLIST (GET-PLVLIST EN))
   ) ; if
   (WRITE-IT VLIST EN)
) ;_ vertext

(defun GET-EN (/ NO-ENT EN MSG1 MSG2)
   (setq NO-ENT 1
         EN     NIL
         MSG1   "\nSelect a polyline: "
         MSG2   "\nNo polyline selected, try again."
   ) ; setq
   (while NO-ENT
      (setq EN (car (entsel MSG1)))
      (if (and EN
               (or (= (DXF 0 EN) "LWPOLYLINE") (= (DXF 0 EN) "POLYLINE")) ; or
          ) ; and
         (progn (setq NO-ENT NIL)) ; progn
         (prompt MSG2)
      ) ; if
   ) ; while
   EN
) ; get-en

(defun GET-LWVLIST (EN / ELIST NUM-VERT VLIST)
   (setq ELIST    (entget EN)
         NUM-VERT (cdr (assoc 90 ELIST))
         ELIST    (member (assoc 10 ELIST) ELIST)
         VLIST    NIL
   ) ; setq
   (repeat NUM-VERT
      (setq VLIST (append VLIST (list (cdr (assoc 10 ELIST)))) ; append
      ) ; setq
      (setq ELIST (cdr ELIST)
            ELIST (member (assoc 10 ELIST) ELIST)
      ) ; setq
   ) ; repeat
   VLIST
) ; get-lwvlist

(defun GET-PLVLIST (EN / VLIST)
   (setq VLIST NIL
         EN    (entnext EN)
   ) ; setq
   (while (/= "SEQEND" (DXF 0 EN))
      (setq VLIST (append VLIST (list (DXF 10 EN))))
      (setq EN (entnext EN))
   ) ; while
   VLIST
) ; get-plvlist

(defun WRITE-IT (VLST EN / NEWVLIST MSG3 FNAME)
   (setq NEWVLIST (mapcar '(lambda (X) (trans X EN 0)) ;_ lambda
                          VLST
                  ) ;_ mapcar
         MSG3     "Polyline vertex file"
        ;FNAME    (getfiled MSG3 "" "txt" 1)
         F1       (open "FNAME" "w")
   ) ; setq
   (WRITE-HEADER)
   (WRITE-VERTICES NEWVLIST)
   (setq F1 (close F1))
) ;_ write-it

(defun WRITE-HEADER (/ STR)
  (setq STR "        POLYLINE VERTEX POINTS")
   (write-line STR F1)
  (setq STR (strcat "  X            " "  Y            " "  Z") ;_ strcat
   ) ;_ setq
   (write-line STR F1)
) ;_ write-header


(defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)



(setq httt "3.75") ;;;;;;;Text Height


(setq gptx (getpoint "\nBasepoint for X axis: "))
(setq gpty (getpoint "\nBasepoint for Y axis: "))

   (foreach ITEM NEWVLIST
      (setq XSTR (rtos (nth 0 ITEM) 2 0)
            YSTR (rtos (nth 1 ITEM) 2 2)
            ZSTR (rtos (nth 2 ITEM) 2 2)
            STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
      ) ; setq
;      (write-line STR F1)
 


(command "text" (list (+(atof xstr)(/ (atof httt) 2.0)) (cadr gptx)) httt "90" (strcat xstr))
(command "text" (list (+(atof xstr)(/ (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr))

   ) ; foreach

) ; write-vertices


(defun SPACES (STR / FIELD NUM CHAR SPACE)
   (setq FIELD 15
         NUM   (- FIELD (strlen STR))
         CHAR  " "
         SPACE ""
   ) ;_ setq
   (repeat NUM (setq SPACE (strcat SPACE CHAR))) ;_ repeat
) ;_ spaces

(defun C:prl () (SETTING) (VERTEXT) (RESETTING) (princ)) ; c:nsl


(prompt "\nCommand: PRL to Start ")


 

9 REPLIES 9
Message 2 of 10
Anonymous
in reply to: Anonymous

Hi,

 

Just try to replace the line:

 

(command "text" (list (+(atof xstr)(/ (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr))

 

with the following one:

 

(command "text" (list (+(atof xstr)(* (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr))

 

HTH

Message 3 of 10
Anonymous
in reply to: Anonymous

Hi HTH

Thanks for reply.

I cannot express what i want exactly. Actually i want to write the upper and lower level apart if these are on the same distance. For further detail i attached profile-1 drawing for reference.

AAK

 

 

Message 4 of 10
Anonymous
in reply to: Anonymous

Looking through your code I can see that yoou are computing only a X and a Y value:

 

 

(setq
XSTR (rtos (nth 0 ITEM) 2 0)
YSTR (rtos (nth 1 ITEM) 2 2)
ZSTR (rtos (nth 2 ITEM) 2 2)
STR (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR)
)

 

so I don't know where are the red numbers (lower level) comming. I see that they are smaller by 10 units than the upper level, so should I assume that these are simply derived from the upper leveles by substracting 10 ?

Message 5 of 10
Anonymous
in reply to: Anonymous

 

Hi SomeBuddy

Forget about the red numbers or unit 10, it is only example it may varies. This lisp calculate the X and Y values of a Polyline.

If the two Y values (levels) are on the same X (Distance) then this lisp write the Upper value Y (level)  on the same X and write lower Y value  apart from upper value as shown in the example drawing.

Here IF command applies but i have not sufficient knowledge how and where to apply it.

AAK

 

 

Message 6 of 10
Anonymous
in reply to: Anonymous

Sorry, but it's still not very clear for me.

 

You say the LISP calculates the x and  y values of the vertices (nodes) of a polyline. Each vertex has a single x and a single y value, so why do you speak about "two Y values (levels)" ?

 

Do you mean that if two consecutive vertices have the same x and different y values ? This would mean that the segment between the two veritices is vertical!

 

And if this is the case, then it would be easy to write them in the order that they are calculated, but if you want to write the bigger y value first and the smaller y value in the second position, then it becomes more complicated to analyse.

 

Can you confirm if what I'm assuming here is correct or not ?

Message 7 of 10
Anonymous
in reply to: Anonymous

Yes that i want  if the two consecutive vertices have the same x and different y values (vertical segment) then the lisp write bigger y value first and the smaller y value in the second position.

Sorry for that i cant explain it because of my poor english.

AAK

Message 8 of 10
Anonymous
in reply to: Anonymous

Then, in your initial code, replace the following:

 

(foreach ITEM NEWVLIST
  (setq XSTR (rtos (nth 0 ITEM) 2 0)
        YSTR (rtos (nth 1 ITEM) 2 2)
        ZSTR (rtos (nth 2 ITEM) 2 2)
        STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR)
  )

(command "text" (list (+(atof xstr)(/ (atof httt) 2.0)) (cadr gptx)) httt "90" (strcat xstr)) (command "text" (list (+(atof xstr)(/ (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr)) )

 

with this:

 

 

(setq lastx nil)
(foreach item newvlist
  (setq
    xstr (rtos (nth 0 item) 2 0)
    ystr (rtos (nth 1 item) 2 2)
    zstr (rtos (nth 2 item) 2 2)
    str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
  )
  (if (/= xstr lastx)
    (progn
      (command "text" (list (+ (atof xstr)(/ (atof httt) 2.0)) (cadr gptx)) httt "90" (strcat xstr))
      (command "text" (list (+ (atof xstr)(/ (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr))
    )
    (command "text" (list (+ (atof xstr)(* (atof httt) 2.0)) (cadr gpty)) httt "90" (strcat ystr))
  )
  (setq lastx xstr)
)

 

 

 

 

Message 9 of 10
Anonymous
in reply to: Anonymous

Thanks SomeBuddy

Exactly that i need

It save lot of time

AOA

Message 10 of 10
Anonymous
in reply to: Anonymous

You're welcome.

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost