LISP for AutoCAD: Modifying a Program for Dad

[omgitsroy326]

I was wondering if anyone was familiar with this language...

Anyhow I'm trying to modify this program for my dad

Currently what this program does:
It draws a thicker line over a selected straight line
and adds dimenetions to the member w/o all the arrows
the dimension is added right below the line centered

What i want it to do :
Add the number "1" on top of the line

In the end :
IT's going to be "1" (centered)... move down a lil the line that has been thickened... finally a dimension centered at the line

cut and paste current program


;****************************MM Cuts
;;;;functions to cut pipe for QUICK CUT

;FUNCTION TO ROUND QUARTER INCH DIMENSIONS TO WHOLE INCHES
(defun round(a / a1 a2 a3)
(setq a1 (- a (fix a)))
(setq a2 0.625 a3 0.375)
(if (> a1 a2) (setq a (+ (fix a) 1) ) )
(if (< a1 a3) (setq a (fix a) ) )
(setq a a);return a to calling routine
)

;FUNCTION TO STRIP FT AND INCH MARKS FROM LENGTHS
(defun strip(s1 / c i l s2)
(setq s2 "" l (strlen s1) i 1)
(repeat l
(setq c (ascii (substr s1 i)))
(if (and (/= c 34) (/= c 39) )
(setq s2 (strcat s2 (chr c)))
)
(setq i (1+ i))
)
(setq s2 s2);return s2 to calling routine
)

;FUNTION TO CONVERT 1/4",1/2",3/4" TO SHP
(defun fract(dimlen)
(setq l (strlen dimlen))
(if (= (substr dimlen (- l 2)) "1/2")
(setq dimlen(strcat(substr dimlen 1 (- l 4)) "h")) )
(if (= (substr dimlen (- l 2)) "1/4")
(setq dimlen(strcat(substr dimlen 1 (- l 4)) "q")) )
(if (= (substr dimlen (- l 2)) "3/4")
(setq dimlen(strcat(substr dimlen 1 (- l 4)) "t")) )
(setq dimlen dimlen);return dimlen to calling routine
)


(defun fixangle (ang2)
(if (and (> ang2 1.58)
(<= ang2 4.715))
(setq ang1 (- ang2 pi))

)
)

(defun chklin ()
(setq pt3 (cdr (assoc '10 enti)))
(setq pt4 (cdr (assoc '11 enti)))
;get length of pipe
(setq d (-(distance pt3 pt4) tkout))
(if (= pl_layr "Y")
(progn
(mvmtest pt3)
(setq pl_ang (angle pt3 pt4))
(setq pl_pt3 (polar pt3 pl_ang pl_takeout))
(mvmtest pt4)
(setq pl_ang (angle pt4 pt3))
(setq pl_pt4 (polar pt4 pl_ang pl_takeout))
);end progn
);endif

;round quarter inch dims 3/4" + 1/4 1/4" - 1/4
(setq d (round d))
(setq num (rtos d 4 2)
num (strip num)
num (fract num)
ang1 (angle pt3 pt4)
)
(fixangle ang1)
(setq mp (polar pt3 (angle pt3 pt4) (/ (distance pt3 pt4) 2) ))

(setq sp (polar mp (- ang1 (/ pi 2)) (+ hgt 3) ) )
(dim_pipe)
(if (= pl_layr "Y") (drplin wdth) )
);end chklin

(defun dim_pipe()
(setq edata (list '(0 . "text")
(cons 10 sp)
(cons 11 sp)
(cons 1 num)
(cons 40 hgt)
'(7 . "pipe")
'(8 . "pipeplen")
'(41 . 0.7)
(cons 50 ang1)
'(72 . 1)
)
)
(entmake edata)
)

;function to draw pline on plot layer overlaying piping
(defun drplin(wdth)
(setq pldata1 (list '(0 . "polyline")
'(8 . "pipepl")
)
)
(setq pldata2 (list '(0 . "vertex")
'(8 . "pipepl")
(cons 10 pl_pt3)
(cons 40 wdth)
(cons 41 wdth)
)
)
(setq pldata3 (list '(0 . "vertex")
'(8 . "pipepl")
(cons 10 pl_pt4)
(cons 40 wdth)
(cons 41 wdth)
)
)
(entmake pldata1)
(entmake pldata2)
(entmake pldata3)
(entmake '((0 . "seqend")))

)

(defun c:cuts (/ s)
(setq pl_takeout 0)
(setvar "cmdecho" 1) (setvar "highlight" 1)
(setvar "dimzin" 1)
(setq nam "CUTS" ;text layer for pipe cuts
hgt 8.0 ;text height
pl_layr "Y"
)
(setq hgt (getreal "\nEnter Text Height for Pipe Dimensions : <8> "))
(if (= hgt nil) (setq hgt 8.0) )
(setq pl_layr (getstring "\Use Plines for Plotting : <Y> "))
(if (= pl_layr "") (setq pl_layr "Y"))
(if (= pl_layr "y") (setq pl_layr "Y"))

(prompt "\nSELECT Pipe Pieces to Cut")
(setq t (ssget ))
(setq tkout (getreal "Enter Total Fitting Takeout in Inches : <0> "))
(if (= tkout nil) (setq tkout 0))
(setq tl (sslength t)
tl (- tl 1)
)
(while (>= tl 0)
(setq enti(entget (ssname t tl)))
(if (= (cdr (assoc '8 enti)) "PIPEMN")
(setq wdth 1.5)
(setq wdth 1.0)
)
(if (and
(= (cdr (assoc '0 enti)) "LINE")
(or (= (cdr (assoc '8 enti)) "PIPEMN") (= (cdr (assoc '8 enti)) "PIPEBL")) )
(progn (chklin) )
)
(if (= (cdr (assoc '0 enti)) "POLYLINE")
(prompt "\nPolylines not cut ... this item skipped"))
(setq tl (- tl 1))
);end while
(setvar "cmdecho" 1) (setvar "highlight" 1)
)


;****************

(defun mvmtest(pt1 / pt2 ss1 sslen countr x y z z1)
(setq pl_takeout 0 pt2 nil x nil y nil z nil ss1 nil sslen nil z1 nil)
(setq pt2 (polar pt1 0.15 12.0))
(setq ss1 (ssget "f" (list pt1 pt2) ))
(setq sslen (sslength ss1))
(if (/= sslen nil) (setq countr 0) (setq countr sslen) )
(while (/= countr sslen)
(setq x (ssname ss1 countr))
(setq y (entget x))
(setq z (cdr (assoc 0 y)))
(if (= z "INSERT")
(progn
(setq z1 (cdr (assoc 2 y)))
(cond
((= (substr z1 1 3) "UPR") (setq pl_takeout 6) )
((= (substr z1 1 3) "SPR") (setq pl_takeout 6) )
((= (substr z1 1 3) "DPE") (setq pl_takeout 6) )
((= (substr z1 1 3) "PEN") (setq pl_takeout 6) )
((= (substr z1 1 3) "RIS") (setq pl_takeout 3) )
(T (prompt "\nNo Legal Block Found at End of Pipe "))
)
(setq countr sslen)
);end progn
;else
(setq pl_takeout 0 countr (+ countr 1))
);endif
);end while
);end mvmtest








;*************************End Mike cuts

 

[enigma]

I have played around with AutoLISP a bit, but it was a while back.

I'm having a bit of trouble following this program because it's not commented at all and it's not formatted properly either. Can you cut and paste it again while putting it inside of [ code ] [ /code ] tags (removing the spaces) to format it, please?

 

[omgitsroy326]

;****************************MM Cuts
;;;;functions to cut pipe for QUICK CUT

;FUNCTION TO ROUND QUARTER INCH DIMENSIONS TO WHOLE INCHES
(defun round(a / a1 a2 a3)
 (setq a1 (- a (fix a)))
 (setq a2 0.625 a3 0.375)
 (if (> a1 a2) (setq a (+ (fix a) 1) ) )
 (if (< a1 a3) (setq a (fix a) ) )
 (setq a a);return a to calling routine
)

;FUNCTION TO STRIP FT AND INCH MARKS FROM LENGTHS
(defun strip(s1 / c i l s2)
 (setq s2 "" l (strlen s1) i 1)
 (repeat l
   (setq c (ascii (substr s1 i)))
   (if (and (/= c 34) (/= c 39) )
       (setq s2 (strcat s2 (chr c)))
   )
   (setq i (1+ i))
 )
 (setq s2 s2);return s2 to calling routine
)

;FUNTION TO CONVERT 1/4",1/2",3/4" TO SHP
(defun fract(dimlen)
     (setq l (strlen dimlen))
     (if (= (substr dimlen (- l 2)) "1/2")
       (setq dimlen(strcat(substr dimlen 1 (- l 4)) "h")) )
     (if (= (substr dimlen (- l 2)) "1/4")
       (setq dimlen(strcat(substr dimlen 1 (- l 4)) "q")) )
     (if (= (substr dimlen (- l 2)) "3/4")
       (setq dimlen(strcat(substr dimlen 1 (- l 4)) "t")) )
     (setq dimlen dimlen);return dimlen to calling routine
)


(defun fixangle (ang2)
 (if (and (> ang2 1.58)
   (<= ang2 4.715))
     (setq ang1 (- ang2 pi))

 )
)

(defun chklin ()
 (setq pt3 (cdr (assoc '10 enti)))
 (setq pt4 (cdr (assoc '11 enti)))
;get length of pipe
 (setq d (-(distance pt3 pt4) tkout))
 (if (= pl_layr "Y")
   (progn
     (mvmtest pt3)
     (setq pl_ang (angle pt3 pt4))
     (setq pl_pt3 (polar pt3 pl_ang pl_takeout))
     (mvmtest pt4)
     (setq pl_ang (angle pt4 pt3))
     (setq pl_pt4 (polar pt4 pl_ang pl_takeout))
    );end progn
  );endif

;round quarter inch dims  3/4" + 1/4   1/4" - 1/4
 (setq d (round d))
 (setq num (rtos d 4 2)
       num (strip num)
       num (fract num)
       ang1 (angle pt3 pt4)
 )
 (fixangle ang1)
 (setq mp (polar pt3 (angle pt3 pt4) (/ (distance pt3 pt4) 2) ))

 (setq sp (polar mp (- ang1 (/ pi 2)) (+ hgt 3) ) )
 (dim_pipe)
  (if (= pl_layr "Y") (drplin wdth) )
);end chklin

(defun dim_pipe()
  (setq edata (list '(0 . "text")
                     (cons 10 sp)
                     (cons 11 sp)
                     (cons 1 num)
                     (cons 40 hgt)
                    '(7 . "pipe")
                    '(8 . "pipeplen")
                    '(41 . 0.7)
                     (cons 50 ang1)
                    '(72 . 1)
               )
  )
  (entmake edata)
)

;function to draw pline on plot layer overlaying piping
(defun drplin(wdth)
  (setq pldata1 (list '(0 . "polyline")
                      '(8 . "pipepl")
                )
  )
  (setq pldata2 (list '(0 . "vertex")
                      '(8 . "pipepl")
                       (cons 10 pl_pt3)
                       (cons 40 wdth)
                       (cons 41 wdth)
                 )
  )
  (setq pldata3 (list '(0 . "vertex")
                      '(8 . "pipepl")
                       (cons 10 pl_pt4)
                       (cons 40 wdth)
                       (cons 41 wdth)
                 )
  )
  (entmake pldata1)
  (entmake pldata2)
  (entmake pldata3)
  (entmake '((0 . "seqend")))

)

(defun c:cuts (/ s)
 (setq pl_takeout 0)
 (setvar "cmdecho" 1) (setvar "highlight" 1)
 (setvar "dimzin" 1)
 (setq nam "CUTS"   ;text layer for pipe cuts
       hgt 8.0      ;text height
       pl_layr "Y"
 )
 (setq hgt (getreal "\nEnter Text Height for Pipe Dimensions : <8> "))
 (if (= hgt nil) (setq hgt 8.0) )
 (setq pl_layr (getstring "\Use Plines for Plotting : <Y> "))
 (if (= pl_layr "") (setq pl_layr "Y"))
 (if (= pl_layr "y") (setq pl_layr "Y"))

 (prompt "\nSELECT Pipe Pieces to Cut")
 (setq t (ssget ))
 (setq tkout (getreal "Enter Total Fitting Takeout in Inches : <0> "))
 (if (= tkout nil) (setq tkout 0))
 (setq tl (sslength t)
       tl (- tl 1)
 )
 (while (>= tl 0)
   (setq enti(entget (ssname t tl)))
   (if (= (cdr (assoc '8 enti)) "PIPEMN")
       (setq wdth 1.5)
       (setq wdth 1.0)
   )
   (if (and
     (= (cdr (assoc '0 enti)) "LINE")
     (or (= (cdr (assoc '8 enti)) "PIPEMN") (= (cdr (assoc '8 enti)) "PIPEBL")) )
     (progn (chklin) )
   )
   (if (= (cdr (assoc '0 enti)) "POLYLINE")
       (prompt "\nPolylines not cut ... this item skipped"))
   (setq tl (- tl 1))
 );end while
 (setvar "cmdecho" 1) (setvar "highlight" 1)
)


;****************

(defun mvmtest(pt1 / pt2 ss1 sslen countr x y z z1)
  (setq pl_takeout 0 pt2 nil x nil y nil z nil ss1 nil sslen nil z1 nil)
  (setq pt2 (polar pt1 0.15 12.0))
  (setq ss1 (ssget "f" (list pt1 pt2) ))
  (setq sslen (sslength ss1))
  (if (/= sslen nil) (setq countr 0) (setq countr sslen) )
  (while (/= countr sslen)
    (setq x (ssname ss1 countr))
    (setq y (entget x))
    (setq z (cdr (assoc 0 y)))
    (if (= z "INSERT")
      (progn
      (setq z1 (cdr (assoc 2 y)))
      (cond
        ((= (substr z1 1 3) "UPR") (setq pl_takeout 6) )
        ((= (substr z1 1 3) "SPR") (setq pl_takeout 6) )
        ((= (substr z1 1 3) "DPE") (setq pl_takeout 6) )
        ((= (substr z1 1 3) "PEN") (setq pl_takeout 6) )
        ((= (substr z1 1 3) "RIS") (setq pl_takeout 3) )
        (T (prompt "\nNo Legal Block Found at End of Pipe "))
      )
      (setq countr sslen)
      );end progn
      ;else
      (setq pl_takeout 0 countr (+ countr 1))
    );endif
  );end while
);end mvmtest








;*************************End Mike cuts

this program uses another program called Sprinkcad which rides on Autocad

anyhow i feel that this line needs to be modified

(defun dim_pipe()
(setq edata (list '(0 . "text")
(cons 10 sp)
(cons 11 sp)
(cons 1 num)
(cons 40 hgt)
'(7 . "pipe")
'(8 . "pipeplen")
'(41 . 0.7)
(cons 50 ang1)
'(72 . 1)
)
)
(entmake edata)
)

but i can't understand it... I've never programed in this type of coding... I'm just trying to get a number "1" on top of the line which it creates...

thanks a lot btw

 

[enigma]

I hate to admit it, but I don't remember enoguh of this to help you much.

The algorithm you're going to want to do is this:

ALGORITHM:
1. Find the start and endpoints of the line, either from the previous code, extracting them from the definition of the line, or having the user select start and endpoints.

2. Find the midpoint of the line by adding half the displacement between the two points to the start point.

3. Find the angle between the start and end. Either add or subtract pi/2 radians from that. This angle will be the angle you're putting the text in at.
You may need to do a bit of if...elseif...elseif... to make sure that the text is always rightside up regardless of start and endpoints of the line. This will be the hardest part of the code, I'd guess

4. Create a point offset from the line X units at the angle previously determined. This will offset the text from the line so they are distinguishable when printing

5. Put the text in.


Some issues you'll have:
What size text do you want to use? Your text size and scales will adjust the text-line offset to make it readable when printing. Depending on how "idiot-proof" you want to make the code, you could go into the drawing registry and pull out the text size of the "current" text style and use a % of that as the offset. Alternatively, you could put in a user-query with a global variable and have right-click have it use the global variable. This way you'd manually set it once and can make changes each time you use the command.

Always remember to have lines which turn off the autosnap before the code does anything. It's one of the big stupid things which AutoCAD does is that the autosnap works when the command is automated even if you're giving specific coordinates. Even dumber, there's no way to turn it off if you're doing a quick command using button scripts.

I will need to do some basic AutoLISP programming over the winter break, so I may be able to help you some there if the problem still exists...

In the meantime, I suggest you check out www.afralisp.com

That's the website which I went to to pick it up last year. They have plenty of tutorials and examples to get you started.

Sorry I couldn't be of more help. Maybe there's someone else on the forums who is a bit more proficient...

 

[omgitsroy326]

hi .. well the current one posted on top

it alread calculates the distance
because when the program runs it does
1) read the line
2) write over the line a thicker more defined line
3) give the length only (so in the codes one of it does get the end point distance and subtracts the two )
3a) now the length of the line is written in the middle of the line a lil below the new line created in 2. (Size 8 font and some pipe font of course this can be changed easily)

This is what i want in addtion
now 4) on top of the line not below , i want the number "1" with size 8 font .