Jump to content
BrianTFC

Repeat or loop

Recommended Posts

BrianTFC

Hi All,

 

I have figured out to combine my three Lisp rputine but it still need works, i need to repeat the last part of the routine until right clicked and i can't figure it out it's driving me nuts. Can some one please help me. Also is there a way to use the the results from the first part of the routine to run the rest of the routine?

 

Thanks, Brian

 

 

 
(defun c:test1( / plines    ; selection set of polylines
           ext    ; extrnal point
            dist    ; distance to offset
            poly    ; a polyline from plines
            plist    ; the list of poly
            del    ; polyline to delete
            int    ; internal point
            i)
 (command "undo" "begin")
 (princ "select polylines")
 (setq plines (ssget)
   i 0
   ext (getvar "limmax")
   dist (getdist (strcat "distance <" (if olddist
                                         (rtos olddist)   ;use old value as default
                                          "") ">"))) 
 (if (not dist) (setq dist olddist))                      ;reuse old distance if user press <Enter>
 (repeat (sslength plines)
   (setq poly (ssname plines i))
   (setq plist (entget poly))
   (command "offset" dist poly ext "")
   (setq del (entlast)
     int (polar
       (cdr (assoc 10 (entget del)))
            (angle
              (cdr (assoc 10 (entget del)))
              (cdr (assoc 10 plist)))
            (* 2 (distance (cdr (assoc 10 plist))
                   (cdr (assoc 10 (entget del)))))))
   (command "offset" dist poly int "")
    (command "_.change" (entlast) "" "_p" "_la" (getvar 'clayer) "")
  (entdel del)
   (setq i (1+ i)))
 (command "undo" "end")
 (setq olddist dist)                                      ;preserve current distance for next run
(vl-load-com)
(princ "\n>>> Select lines to extend/reduce <<< ")
(if
(and
(setq lSet
(ssget
'((0 . "LINE"))));
(setq lDel
(getreal "\nSpecify : "))
); end and
(progn
(initget 1 "Positive Negative Both")
(setq doMode
(getkword "\nSpecify direction [Positive/Negative/Both]: ")
objLst(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp 
(mapcar 'cadr(ssnamex lSet))))); end setq
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object)))); end vla-StartUndoMark
(if(member doMode '("Negative" "Both"))
(foreach ln objLst
(vlax-put ln 'startpoint
(polar
(vlax-get ln 'startpoint)
(vlax-get ln 'angle)(- lDel))); end vlax-put
); end foreach
); end if
(if(member doMode '("Positive" "Both"))
(foreach ln objLst
(vlax-put ln 'endpoint
(polar
(vlax-get ln 'endpoint)
(vlax-get ln 'angle)lDel))
); end foreach
); end if
(vla-EndUndoMark actDoc)
); end progn
); end if
(vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LWPOLYLINE" "POLYLINE" "LINE")))
   (progn
     (setq tStr (strcat "1@" (rtos (- (vla-get-length
                        (vlax-ename->vla-object cEnt)) 5.38)) (strcat "''"))
           tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
           tHgt (- (cadadr tBox) (cadar tBox))
           twid (- (caadr tBox) (caar tBox)))
     (princ "\nPosition Text...")
          
      (while (eq 5 (car (setq gr (grread t 5 0))))
            (redraw)
       (if (listp (setq sPt (cadr gr)))
         (progn
           (setq cPt  (vlax-curve-getClosestPointto cEnt sPt)
                 lAng (angle cPt sPt)
                 bpt  (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
                 tpt  (polar bpt lAng tHgt)
                 mPt  (polar bPt lAng (/ tHgt 2.))
                 pt1  (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt2  (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
                 pt3  (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt4  (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
           (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
     (if (eq 3 (car gr))
       (progn
         (setq lAng (- lAng (/ pi 2.)))
         (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                (setq lAng (- lAng pi)))
               ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                (setq lAng (+ lAng pi))))
         (Make_Text mPt tStr lAng))))
   (princ "\n<!> Incorrect Selection <!>"))
 (redraw)
 (princ))
(defun Make_Text  (pt val rot)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 62 1)
     (cons 10 pt)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 rot)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt)))
    
)
(princ)

Share this post


Link to post
Share on other sites
jammie

Hi Brian,

 

You seem to have a good handle on the auto/visual lisp functions. Could you please explain what exactly you are trying to achieve with your program?

 

Regards

 

Jammie

Share this post


Link to post
Share on other sites
BrianTFC

Hi,

 

When the lisp routine runs it does the first two parts just fine but when it gets to the last part it only lets me pick one line then ends the command, what i would like to do is pick as many lines that i need to and then right click out of the command. any thoughts.

Share this post


Link to post
Share on other sites
BrianTFC

Hi Lee

 

Yes Lee it does have a part of the PLLEN.lsp routine you wrote along time ago. Thanks to people like you we novice can learn how to write routines that work for what we need done. Many Thanks Lee.

 

Brian

Share this post


Link to post
Share on other sites
BrianTFC

Hi,

 

I didn't mean to offend anybody. When i was combinding them together i just used the lines that pertained to the function of the lisp routine. Many apolyogies. I will remeber that for the future.

 

Brian

Share this post


Link to post
Share on other sites
fuccaro

No offense was taken, it was just a friendly word of warning. If you will keep that in your mind for the future, that's good.

Share this post


Link to post
Share on other sites
Dadgad
Hi,

 

I didn't mean to offend anybody. When i was combinding them together i just used the lines that pertained to the function of the lisp routine. Many apolyogies. I will remeber that for the future.

 

Brian

 

Brian, both fuccaro & Lee are right in the leading pack of those who have donated mind blowing amounts of code, expertise and energy to helping others on this site and elsewhere for years now. Presumably you noticed the reference to fuccaro's posted code too? :wink:

Share this post


Link to post
Share on other sites
fuccaro

Thanks Dadgad!

I think we can consider this issue belonging to the past. I just post here a link to a thread about copyright, and now myself I consider this subject closed.

Share this post


Link to post
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.   Paste as plain text instead

  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...