- #1
omgitsroy326
- 30
- 0
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
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