Author Topic: Need repeat loop help  (Read 1660 times)

0 Members and 1 Guest are viewing this topic.

jlogan02

  • Bull Frog
  • Posts: 327
Need repeat loop help
« on: April 18, 2018, 12:56:48 PM »
I've combined a portion of Lee Mac's StrikethroughV1-1.lsp with a routine to copy a piece of text and turn the original text red...

It only runs once, then I have to for now, drag and drop to run again. If I hit an Enter after the first run through ACAD executes the last issued AutoCAD command.

What I'm trying to achieve.
User selects text to copy
User places copied text at new point and the original text is turned to RED
Routine draws a line through the copied text with the line being put on the "Cloud" layer.
Tedit command selects the original piece of text for user to edit. I haven't added this yet.
Repeats for user to select another piece of text to copy/change/strike and edit.

Code - Auto/Visual Lisp: [Select]
  1. ;; Single Strikethrough
  2.  
  3. (defun strike ( / i s )
  4.     (if (setq s (ssget '((0 . "TEXT,MTEXT"))))
  5.         (repeat (setq i (sslength s))
  6.             (LM:strikethrough (ssname s (setq i (1- i)))
  7.                '(
  8.                     (0.0 0.1)
  9.                 )
  10.             )
  11.         )
  12.     )
  13.     (princ)
  14. )
  15.  
  16. ;; Strikethrough Text  -  Lee Mac
  17. ;; Generates polylines through the supplied text object, with spacing & width given by the supplied parameter list.
  18. ;; ent - [ent] Text or MText entity
  19. ;; par - [lst] List of ((<Spacing Factor> <Width Factor>) ... ) for each polyline
  20. ;; Returns: [lst] List of created polyline entities
  21.  
  22. (defun LM:strikethrough ( ent par / ang enx hgt lst md1 md2 rtn )
  23.     (if (setq lst (mytextbox (setq enx (entget ent))))
  24.         (progn
  25.             (setq hgt (cdr (assoc 40 enx))
  26.                   md1 (mid   (car  lst) (last  lst))
  27.                   md2 (mid   (cadr lst) (caddr lst))
  28.                   ang (angle (car  lst) (last  lst))
  29.             )
  30.             (foreach itm par
  31.                 (setq rtn
  32.                     (cons
  33.                         (entmakex
  34.                             (append
  35.                                '(   (000 . "LWPOLYLINE")
  36.                                     (100 . "AcDbEntity")
  37.                                     (100 . "AcDbPolyline")
  38.                                     (008 . "CLOUD")
  39.                                     (090 . 1)
  40.                                     (070 . 0)
  41.                                 )
  42.                                 ;(LM:defaultprops enx)
  43.                                 (list
  44.                                     (cons  043 (* (cadr itm) hgt))
  45.                                     (cons  038 (caddar lst))
  46.                                     (cons  010 (polar md1 ang (* (car itm) hgt)))
  47.                                     (cons  010 (polar md2 ang (* (car itm) hgt)))
  48.                                     (assoc 210 enx)
  49.                                 )
  50.                             )
  51.                         )
  52.                         rtn
  53.                     )
  54.                 )
  55.             )
  56.         )
  57.     )
  58.     rtn
  59. )
  60.  
  61. ;; Midpoint  -  Lee Mac
  62. ;; Returns the midpoint of two points
  63.  
  64. (defun mid ( a b )
  65.     (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
  66. )
  67.  
  68. ;; Default Properties  -  Lee Mac
  69. ;; Returns a list of DXF properties for the supplied DXF data,
  70. ;; substituting default values for absent DXF groups
  71.  
  72. (defun LM:defaultprops ( enx )
  73.     (mapcar '(lambda ( x ) (cond ((assoc (car x) enx)) ( x )))
  74.        '(
  75.             (006 . "BYLAYER")
  76.             (008 . "0")
  77.             (039 . 0.0)
  78.             (048 . 0.0)
  79.             (062 . 256)
  80.             (370 . -1)
  81.         )
  82.     )
  83. )
  84.  
  85. ;; Text Box  -  gile / Lee Mac
  86. ;; Returns an OCS point list describing a rectangular frame surrounding the supplied Text or MText entity
  87. ;; enx - [lst] Text or MText DXF data list
  88.  
  89. (defun mytextbox ( enx / bpt hgt jus lst ocs org rot wid )
  90.     (cond
  91.         (   (= "TEXT" (cdr (assoc 00 enx)))
  92.             (setq bpt (cdr (assoc 10 enx))
  93.                   rot (cdr (assoc 50 enx))
  94.                   lst (textbox enx)
  95.                   lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
  96.             )
  97.         )
  98.         (   (= "MTEXT" (cdr (assoc 00 enx)))
  99.             (setq ocs  (cdr (assoc 210 enx))
  100.                   bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
  101.                   rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
  102.                   wid  (cdr (assoc 42 enx))
  103.                   hgt  (cdr (assoc 43 enx))
  104.                   jus  (cdr (assoc 71 enx))
  105.                   org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
  106.                              (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
  107.                        )
  108.                   lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
  109.             )
  110.         )
  111.     )
  112.     (if lst
  113.         (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
  114.             (list
  115.                 (list (cos rot) (sin (- rot)) 0.0)
  116.                 (list (sin rot) (cos rot)     0.0)
  117.                '(0.0 0.0 1.0)
  118.             )
  119.         )
  120.     )
  121. )
  122.  
  123. ;; Matrix x Vector  -  Vladimir Nesterovsky
  124. ;; Args: m - nxn matrix, v - vector in R^n
  125.  
  126. (defun mxv ( m v )
  127.     (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  128. )
  129.  
  130. (defun RedText ( / ENT S SS)
  131.   (setq ss (ssadd)
  132.         ent (entlast))
  133. (if (setq s (ssget "_:L" '((0 . "*TEXT"))))
  134.   (progn
  135.     (command "_.copy" s "" pause pause)
  136.   (while (setq ent (entnext ent))
  137.     (ssadd ent ss)
  138.   )
  139.     (if ss
  140.       (command "_.chprop" s "" "_C" "1" "")
  141.        )
  142.     )
  143.   )
  144.   (princ)
  145.   )
  146. (REDTEXT)
  147. (STRIKE)

It's not possible in it's current state, but my original idea was...
User selects text to copy.
Text is copied and placed by user and line on "cloud" layer is drawn through text
User continues copy/strike through as many times as they want.
Routine remembers the order the original text was selected, changes all original text to red and executes the TEdit command in original selected order.

J. Logan
ACAD 2015 
« Last Edit: April 18, 2018, 01:00:08 PM by jlogan02 »
J. Logan
ACAD 2018

I am one with the Force and the Force is with me.
AutoCAD Map 2018 Windows 10

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Need repeat loop help
« Reply #1 on: April 18, 2018, 01:01:19 PM »
Remove the last 2 line of code
Change to (defun c:strike...

Then you can hit enter to re run the code.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jlogan02

  • Bull Frog
  • Posts: 327
Re: Need repeat loop help
« Reply #2 on: April 18, 2018, 01:42:30 PM »
I changed line 3 in my original post to...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:strike ( / i s )

and

Removed..
Code - Auto/Visual Lisp: [Select]
  1. (REDTEXT)
  2. (STRIKE)

This resulted in the routine running fine the first time. The next selected text object resulted in just a strike through of the text not the copy text first then the strikethrough.

While I was waiting for replies I tried...

Code - Auto/Visual Lisp: [Select]
  1. (REDTEXT)
  2. (STRIKE)
  3. )

This seemed to work

I then added this below the REDTEXT routine...

Code - Auto/Visual Lisp: [Select]
  1. (defun EditRed ( / )
  2.  ;;(setq sel1 (ssget '((0 . "circle"))))
  3.  (command "Textedit" s "")
  4.  (sssetfirst nil s)
  5.  (princ)
  6. )

and added (EDITRED) to the while loop.
It's close but not quite.

J. Logan
ACAD 2015
J. Logan
ACAD 2018

I am one with the Force and the Force is with me.
AutoCAD Map 2018 Windows 10

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Need repeat loop help
« Reply #3 on: April 18, 2018, 02:54:02 PM »
Try this:
Code: [Select]
(defun c:strike ( / i s )
(REDTEXT)

I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jlogan02

  • Bull Frog
  • Posts: 327
Re: Need repeat loop help
« Reply #4 on: April 23, 2018, 11:02:57 AM »
I ended up doing the while loop and adding Tedit.

Code - Auto/Visual Lisp: [Select]
  1. (defun strike ( / i s )...
  2.  
  3. ...
  4.  
  5. (defun EditRed ( / )
  6.  (command "Textedit" s)
  7.  ;;(sssetfirst nil s)
  8.  (princ)
  9. )
  10.  
  11. (REDTEXT)
  12. (STRIKE)
  13. (EDITRED)
  14. )

Works fine but after some thought over the weekend I realized I was thinking too small. What needs to happen...

User selects text to copy.
Original Text is changed to red.
A cross is put on copied text. Like Lee's Strikethrough routine the cross would match the width of the text.
Copied text is put on a "TRASH" layer along with cross.
Original text is issued the Text Edit command.

By putting both the cross and the copied text on a "TRASH" layer, I can come back at a later date and erase all with a selection set of the "TRASH" layer.



J. Logan
ACAD 2018

I am one with the Force and the Force is with me.
AutoCAD Map 2018 Windows 10

BIGAL

  • Swamp Rat
  • Posts: 1410
  • 40 + years of using Autocad
Re: Need repeat loop help
« Reply #5 on: May 01, 2018, 05:10:15 AM »
You can use C: defuns as well by just that use full name (c:strike) I often add this as a last line so if I load a lisp it runs 1st time without having to type STRIKE. After that you can run any time by typing command.
A man who never made a mistake never made anything