danleebank Posted August 21, 2017 Posted August 21, 2017 Hi All, I have a lisp that is working wonderfully besides how it generates text. Currently the labels it creates are normal text and red on the current layer however our company standard requires Mtext. Also, for that Mtext to be yellow and on layer M_TEXT (which should already be defined when using this lisp) I could use some assistance in understanding this. Ive been able to create a few simple lisps but understanding this one, im in a bit over my head. The lisp creates ductwork and places labels in the straight sections. My biggest goal is to have it generate Mtext, then the color would be nice then layer would be last priority since its easy enough to just select similar and move it. Could you guys/gals help me out? (defun bd( dpipepwd dpipeert) (if (not (tblsearch "LAYER" "axes")) (command "_.-layer" "_m" "axes" "_c" "1" "" "_lt" "center" "" "") ) ;centerline properties format '("layer" "color" "ltype" "lweight") (setq dpropcln '("axes" "Bylayer" "Bylayer" "")) (if (not (tblsearch "LAYER" "patt")) (command "_.-layer" "_m" "patt" "_c" "8" "" "_lt" "continuous" "" "") ) ;dproppat = hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight") (setq dproppat '("ANSI32" 50.0 "patt" "Bylayer" "Bylayer" "")) (if (not (tblsearch "LAYER" "1")) (command "_.-layer" "_m" "1" "_c" "7" "" "_lt" "continuous" "" "") ) ;dpropobj = objectline properties format '("layer" "color" "ltype" "lweight") (setq dpropobj '("1" "Bylayer" "Bylayer" "")) (ductmain "Radius" dpipeert (/ pi 12) "None" 3 dpipepwd dpipesuf nil) ) ;dproptxt = text/label properties format '("style" "textsize" "layer" "color" "ltype" "lweight") ;(setq dproptxt '("Label" 0.1 "text" "Bylayer" "Bylayer" "")) ;(if (not (tblsearch "STYLE" "Label")) ; (command "_.-style" "Label" "romans" 0.0 1.0 0.0 "_N" "_N" "_N") ; ) ; ;(ductmain "Mitered" 6 (/ pi 12) "None" 3 12 "x12" nil) ;(ductmain "Radius" "1.5" (/ pi 12) "All" 3 12 "%%c" nil) ;(defun c:tray( / LAY) ;;dproppat = hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight") ;(setq dproppat '("MUDST" 4.0 "" "8" "Bylayer" "")) ;(ductmain "Chamfered" 6 (/ pi 12) "All" 2 nil " " nil) ;(defun c:pipe() ;(ductmain "Radius" "1.5" (/ pi 12) "None" 3 nil (strcat (if (= (getvar "MEASUREMENT") 0) "\"" "") "%%C") nil) ;(defun c:duct() ;(ductmain nil nil (/ pi 12) "None" nil nil nil nil) (defun ductmain ( dpipeelb dpipeert dpipetrn dpipepat dpipecln dpipepwd dpipesuf dpipefpt / actDoc ang1 ang2 ang3 ptLst enDist dlastfpt dpipetan dpiperad ; = specified radius fPt lEnt lObj lPln oldVars oldWd plEnd plStart1 plStart2 pwd prDir dlp txEnt OldLineType NewLineType segLst Start stDist stLst tAng vlaPln cFlg *error* ;dpipewd ) (vl-load-com) (defun GetPlineVer(plObj) (mapcar 'cdr (vl-remove-if-not '(lambda(x)(=(car x)10)) (entget plObj))) ); end of GetPLineVer (defun asmi-PlineSegmentDataList(plObj / cLst outLst) (setq cLst (vl-remove-if-not '(lambda(x)(member(car x) '(10 40 41 42))) (entget plObj)) outLst '() ); end setq (while cLst (if(assoc 40 cLst) (progn (setq outLst (append outLst (list (list (cdr(assoc 10 cLst)) (cdr(assoc 40 cLst)) (cdr(assoc 41 cLst)) (cdr(assoc 42 cLst)) ); end list ); end list ); end if ); end setq (repeat 4 (setq cLst(cdr cLst)) ); end repeat ); end progn (setq outLst (append outLst (list (list (cdr(assoc 10 cLst)) ); end list ); end list ); end append cLst nil ); end setq ); end if ); end while outLst ); end of asmi-GetPlineSegmentData (defun asmi-LayersUnlock(/ restLst) (setq restLst '()) (vlax-for lay (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (setq restLst (append restLst (list (list lay (vla-get-Lock lay) (vla-get-Freeze lay) ); end list ); end list ); end append ); end setq (vla-put-Lock lay :vlax-false) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Freeze(list lay :vlax-false))) t) ); end vlax-for restLst ); end of asmi-LayersUnlock (defun asmi-LayersStateRestore(StateList) (foreach lay StateList (vla-put-Lock(car lay)(cadr lay)) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Freeze(list(car lay)(nth 2 lay)))) t) ); end foreach (princ) ); end of asmi-LayersStateRestore (defun PipeMLineStyle(/ dxfLst mlDict) (setq dxfLst (list'(0 . "MLINESTYLE")'(102 . "{ACAD_REACTORS")'(102 . "}") '(100 . "AcDbMlineStyle") '(2 . "DUCT_PIPE") '(70 . 274)'(3 . "")'(62 . 256)'(51 . 1.5708)'(52 . 1.5708) '(71 . 2)'(49 . 0.5)'(62 . 256)'(6 . "BYBLOCK") '(49 . -0.5)'(62 . 256)'(6 . "BYBLOCK"))); end setq (if (null (member (assoc 2 dxfLst) (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))) (progn (setq mlDict (cdr (assoc -1 (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))) (dictadd mlDict (cdr(assoc 2 dxfLst))(entmakex dxfLst)) ); end progn ); end if ); end of PipeMLineStyle (defun SideCalculate(Wdth Ang / Rad) (setq Ang(- pi Ang)) (setq Rad(+ (* 0.5 Wdth)(if (/= "Segmented" dpipeelb "Radius") 0.0 (if (numberp dpiperad) dpiperad (* (- (distof dpiperad) 0.5) Wdth)))) ) (+ (if (/= "Chamfered" dpipeelb "Mitered") 0 (if (= dpipeelb "Mitered") dpipetan (+ (* dpipetan 0.5) (/ dpipetan 2.0 (cos (/ Ang 2.0)))) ) ) (* (/ (sqrt(-(* 2(expt Rad 2))(* 2(expt Rad 2)(cos Ang)))) (sin(- pi Ang)))(sin(/(- pi(- pi Ang))2.0) ) ) ) ); end of SideCalculate (defun BodyFunction() (if (not (equal lObj(entlast))) (progn (setq lEnt(entlast) stLst(asmi-LayersUnlock) segLst(asmi-PlineSegmentDataList lEnt) vlaPln(vlax-ename->vla-object lEnt) ); end setq (setvar "OSMODE" 0) (setvar "CMDECHO" 0) (if (/= 1 (length segLst)) (progn (if (or (/= (type dpropcln) 'LIST) (not (equal (mapcar 'type dpropcln) '(STR STR STR STR)))) (setq dpropcln '("" "7" "Center2" ""));centerline properties format '("layer" "color" "ltype" "lweight") ) (if (and (= (logand dpipecln 1) 1) (read (caddr dpropcln)) (not (member (strcase (caddr dpropcln)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (caddr dpropcln)))) (command "_.linetype" "_l" (caddr dpropcln) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "") ) (if (or (/= (type dproppat) 'LIST) (not (equal (mapcar 'type dproppat) '(STR REAL STR STR STR STR)))) (setq dproppat '("ANSI32" 50.0 "" "8" "" ""));hatching properties format '("name" "scale" "layer" "color" "ltype" "lweight") ) (if (and (/= dpipepat "None") (read (nth 4 dproppat)) (not (member (strcase (nth 4 dproppat)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (nth 4 dproppat)))) (command "_.linetype" "_l" (nth 4 dproppat) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "") ) (if (or (/= (type dproptxt) 'LIST) (not (equal (mapcar 'type dproptxt) '(STR REAL STR STR STR STR)))) (setq dproptxt (list (getvar "TEXTSTYLE") (getvar "TEXTSIZE") "" "1" "" ""));text label properties format '("style" "textsize" "layer" "color" "ltype" "lweight") ) );end progn );end if (while (/= 1(length segLst)) (setq stDist (vlax-curve-getDistAtPoint vlaPln (caar segLst)) enDist (vlax-curve-getDistAtPoint vlaPln (caadr segLst)) ); end setq (if(< 2(length segLst)) (progn (setq ang1 (+(/ pi 2)(angle(caar segLst)(caadr segLst))) ang2 (+(/ pi 2)(angle(caadr segLst)(car(nth 2 segLst)))) ); end setq ); end progn ); end if (if (or (not Start) prDir );end or (setq plStart1 (vlax-curve-getPointAtDist vlaPln stDist) Start T); end setq (setq plStart1 (vlax-curve-getPointAtDist vlaPln (+ stDist(SideCalculate(cadar segLst)ang3)))); end setq ); end if (if(and ang1 ang2) (progn (if(> ang1 ang2) (setq ang3(- ang1 ang2)) (setq ang3(- ang2 ang1)) ); end if (setq ang3(- pi ang3) tAng ang3) (if(minusp ang3)(setq ang3(- ang3))) ); end progn ); end if (if (or (equal ang1 ang2 0.000001) (= 2(length segLst)) ); end or (setq plEnd (vlax-curve-getPointAtDist vlaPln enDist) prDir T); end setq (setq plEnd (vlax-curve-getPointAtDist vlaPln (- enDist(SideCalculate(cadar segLst)ang3))) prDir nil); end setq ); end if (if (< 2(length segLst)) (setq plStart2 (vlax-curve-getPointAtDist vlaPln (+ enDist(SideCalculate(cadar segLst)ang3)))); end setq ); end if (if(< 2(length segLst)) (if (=(cadar segLst)(nth 2(car segLst))) (setq ptLst (mapcar '(lambda(x)(trans x 0 1)); end lambda (append (if (/= dpipeelb "Radius") (progn (setq ang4 (apply '(lambda(x)(atan x (sqrt (abs (1- (* x x)))))) (list (sin (- ang1 (/ pi 2.0) (angle plEnd plStart2))))) ) (setq SegNum (cond ((or (/= dpipeelb "Segmented") (< (abs ang4) (* (/ 35 360.0) pi))) 2) ((< (abs ang4) (* (/ 55 360.0) pi)) 3) ((< (abs ang4) (* (/ 75 360.0) pi)) 4) (T 5)) ) (setq tan4 (+ (if (= dpipeelb "Segmented") 0 (if (= dpipeelb "Mitered") dpipetan (+ (* dpipetan 0.5) (/ dpipetan 2.0 (cos ang4))))) (* (+ (* 0.5 (cadar segLst)) (if (/= dpipeelb "Segmented") 0.0 (if (numberp dpiperad) dpiperad (* (- (distof dpiperad) 0.5) (cadar segLst))))) (abs (apply '(lambda(x) (/ (sin x) (cos x))) (list (/ ang4 0.5 (1- SegNum) 2.0)))))) ) (setq mllst (list plEnd (polar plEnd (- ang1 (/ pi 2.0)) tan4))) (setq SegCnt 0) (while (< (+ SegCnt 2) SegNum) (setq mllst (append mllst (list (polar (last mllst) (+ (angle (cadr (reverse mllst)) (last mllst)) (/ ang4 -0.5 (1- SegNum))) (* tan4 2.0))) ) SegCnt (1+ SegCnt) ) ) (setq mllst (append mllst (list PlStart2))) (setq SegCnt (- (length mllst) 2)) (setq pllst nil) (if (and (= dpipeelb "Chamfered") (< (distance (polar plStart2 ang2 (/(cadar segLst)2)) (polar plEnd ang1 (/(cadar segLst)2))) (distance (polar plStart2 (+ pi ang2) (/(cadar segLst)2)) (polar plEnd (+ pi ang1) (/(cadar segLst)2))))) (setq pllst (list(polar (polar plStart2 ang2 (/(cadar segLst)2)) (+ ang2 (/ pi 2)) (* dpipetan 0.5)) (polar (polar plEnd ang1 (/(cadar segLst)2)) (- ang1 (/ pi 2)) (* dpipetan 0.5))) ) (while (> SegCnt 0) (setq pllst (append pllst (list (polar (nth SegCnt mllst) (+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst)) (/ pi 2.0) (/ ang4 0.5 (1- SegNum) -2.0)) (/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0))))) ) SegCnt (1- SegCnt) ) ) ) ; ) pllst ) ) (list(polar plEnd ang1 (/(cadar segLst)2))) (list(polar plEnd (+ pi ang1)(/(cadar segLst)2))) (if (/= dpipeelb "Radius") (progn (setq SegCnt 1) (setq pllst nil) (if (and (= dpipeelb "Chamfered") (< (distance (polar plStart2 (+ pi ang2) (/(cadar segLst)2)) (polar plEnd (+ pi ang1) (/(cadar segLst)2))) (distance (polar plStart2 ang2 (/(cadar segLst)2)) (polar plEnd ang1 (/(cadar segLst)2))))) (setq pllst (list(polar (polar plEnd (+ pi ang1) (/(cadar segLst)2)) (- ang1 (/ pi 2)) (* dpipetan 0.5)) (polar (polar plStart2 (+ pi ang2) (/(cadar segLst)2)) (+ ang2 (/ pi 2)) (* dpipetan 0.5))) ) (while (< SegCnt (1- (length mllst))) (setq pllst (append pllst (list (polar (nth SegCnt mllst) (+ (angle (nth (1- SegCnt) mllst) (nth SegCnt mllst)) (* pi 1.5) (/ ang4 0.5 (1- SegNum) -2.0)) (/(cadar segLst)2(cos (/ ang4 0.5 (1- SegNum) 2.0))))) ) SegCnt (1+ SegCnt) ) ) ) (setq mllst (mapcar '(lambda(x)(trans x 0 1)) mllst)) pllst ) ) (list(polar plStart2 (+ pi ang2)(/(cadar segLst)2))) (list(polar plStart2 ang2 (/(cadar segLst)2))) ); end append ); end mapcar ); end setq (setq ptLst (mapcar '(lambda(x)(trans x 0 1)); end lambda (list (polar plStart1 ang1 (/(cadar segLst)2)) (polar plStart1 (+ pi ang1)(/(cadar segLst)2)) (polar(caadr segLst)(+ pi ang2)(/(nth 2(car segLst))2)) (polar(caadr segLst)ang2(/(nth 2(car segLst))2)) ); end list ); end mapcar ); end setq ); end if ); end if (setq plStart1(trans plStart1 0 1) plEnd(trans plEnd 0 1) ); end setq (if plStart2 (setq plStart2(trans plStart1 0 1)) ); end if (if (< 2(length segLst)) (if (or (/=(cadar segLst)(nth 2(car segLst))) (and (/= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001)) ); end and ); end or (progn (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command ptLst)(command "_c") (setvar "PLINEWID" dpipepWd) (if (and (/= dpipepat "None") (or (/= (cadar segLst) (nth 2(car segLst))) (and (not (equal ang1 ang2 0.000001)) (= dpipepat "All") (/= "Radius" dpipeelb)))) (command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "") ) (if (and (= (logand dpipecln 1) 1) (or (equal ang1 ang2 0.000001) (/= "Radius" dpipeelb))) (progn (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command (if (/= (cadar segLst) (nth 2(car segLst))) (list plStart1 plEnd) mlLst)) (command "") (setvar "PLINEWID" dpipepWd) (command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "") ); end progn ) ); end progn (if (and (= "Segmented" dpipeelb) (not(equal ang1 ang2 0.000001))) (progn ; (command "_.mline" "_st" "DUCT_PIPE" "_S" (cadar segLst) "_J" "_Z") ; (mapcar 'command mlLst) ; (command "") (setvar "PLINEWID" 0.0) (setq SegCnt 0) (while (< SegCnt (1- SegNum)) (command "_.line" (nth SegCnt ptlst) (nth (- (length ptlst) 3 SegCnt) ptlst) "" ) (setq SegCnt (1+ SegCnt)) ) (command "_.pline") (mapcar 'command ptLst)(command "_c") (setvar "PLINEWID" dpipepWd) (if (= dpipepat "All") (command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "") ) (if (= (logand dpipecln 1) 1) (progn (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command (if (= (logand dpipecln 3) 3) mlLst (list (car mlLst) (trans (caadr segLst) 0 1) (last mlLst)))) (command "") (setvar "PLINEWID" dpipepWd) (command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "") ); end progn ); end if ); end progn ); end if ); end if ); end if (if (and (= dpipeelb "Radius") (not(equal ang1 ang2 0.000001)) (< 2(length segLst)) ); end and (progn (setq lPln (vlax-ename->vla-object(entlast)) tAng (abs (- ang2 ang1)) ); end setq (if (> tAng pi) (if(< ang1 ang2) (setq ang1(+ ang1 pi) ang2(- ang2 pi)); end setq (setq ang1(- ang1 pi) ang2(+ ang2 pi)); end setq ); end if ); end if (setq Bulge(/(sin(/(rem(- ang2 ang1)pi)4.0))(cos(/(rem(- ang2 ang1)pi)4.0)))) (vla-SetBulge lPln 1 Bulge) (vla-SetBulge lPln 3 (- Bulge)) (if (= dpipepat "All") (progn (command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "") ) ) (if (= (logand dpipecln 1) 1) (progn (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command (append (list (mapcar '/ (mapcar '+ (car ptLst) (cadr ptLst)) '(2.0 2.0 2.0))) (if (/= (logand dpipecln 3) 3) (list (trans (caadr segLst) 0 1))) (list (mapcar '/ (mapcar '+ (caddr ptLst) (last ptLst)) '(2.0 2.0 2.0))))) (command "") (if (= (logand dpipecln 3) 3) (vla-SetBulge (vlax-ename->vla-object(entlast)) 0 Bulge)) (setvar "PLINEWID" dpipepWd) (command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "") ); end progn ); end if ); end progn ); end if (if (or (=(cadar segLst)(nth 2(car segLst)))(= 2(length segLst))) (progn ; (if (=(cadar segLst)(nth 2(car segLst))) ; (command "_.mline" "_st" "DUCT_PIPE" "_S" (cadar segLst) "_J" "_Z" plStart1 plEnd "") (progn (setq ptLst (list (polar plStart1 (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2)) (polar plStart1 (- (angle plStart1 plEnd) (/ pi 2.0)) (/(cadar segLst)2)) (polar plEnd (- (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2)) (polar plEnd (+ (angle plStart1 plEnd) (/ pi 2.0)) (/(nth 2(car segLst))2)) ) ) (setvar "PLINEWID" 0.0) (command "_.pline") (mapcar 'command ptLst)(command "_c") (setvar "PLINEWID" dpipepWd) (if (/= dpipepat "None") (command "_.hatch" (nth 0 dproppat) (nth 1 dproppat) (if (< (sin (* PI 0.125)) (abs (sin ang1)) (sin (* PI 0.375))) 45 0) "_l" "" "_.change" "_l" "" "_p" "_la" (nth 2 dproppat) "_c" (nth 3 dproppat) "_lt" (nth 4 dproppat) "_lw" (nth 5 dproppat) "") ) ) ; ) (if (= (logand dpipecln 1) 1) (progn (setvar "PLINEWID" 0.0) (command "_.pline" plStart1 plEnd "") (setvar "PLINEWID" dpipepWd) (command "_.change" "_l" "" "_p" "_la" (nth 0 dpropcln) "_c" (nth 1 dpropcln) "_lt" (nth 2 dpropcln) "_lw" (nth 3 dpropcln) "") ); end progn ) (if (and (/= " " dpipesuf) (=(cadar segLst)(nth 2(car segLst)))) (progn (command "_.text" "_s" (nth 0 dproptxt) "_j" "_mc" (mapcar '/ (mapcar '+ plStart1 plEnd) '(2.0 2.0 2.0))) (if (= (cdr (assoc 40 (tblsearch "style" (getvar "TEXTSTYLE")))) 0) (command (nth 1 dproptxt)) ) (command (if (and (> (setq tAng (/ (* 180 (angle plStart1 plEnd)) PI)) 112.5)(<= tAng 292.5)) (+ tAng 180) tAng) (strcat (rtos (cadar segLst) (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) dpipesuf)) (if (>= (atof (getvar "ACADVER")) 16.1) (progn (setq txEnt (entget (entlast))) (setq ptLst (textbox txEnt)) (entdel (cdr (assoc -1 txEnt))) (setq txEnt (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (assoc 7 txEnt) (assoc 8 txEnt) (assoc 40 txEnt) (cons 1 (if (/= nil (cdr (assoc 51 txEnt)) 0) (strcat "{\\Q" (dectos (deg (cdr (assoc 51 txEnt)))) ";" (cdr (assoc 1 txEnt)) "}") (cdr (assoc 1 txEnt)))) (cons 10 (polar (polar (cdr (assoc 10 txEnt)) (+ (cdr (assoc 50 txEnt)) (/ PI 2.0)) (+ (cadar ptLst) (/ (- (cadadr ptLst) (cadar ptLst)) 2.0))) (cdr (assoc 50 txEnt)) (+ (caar ptLst) (/ (- (caadr ptLst) (caar ptLst)) 2.0)))) (assoc 210 txEnt) (assoc 50 txEnt) '(71 . 5) '(72 . 5) '(90 . 1) '(63 . 1) '(45 . 1.25)) ) (entmake txEnt) (setq txEnt (subst '(90 . 3) '(90 . 1) (entget (entlast)))) (entmod txEnt) ) ) (command "_.change" "_l" "" "_p" "_la" (nth 2 dproptxt) "_c" (nth 3 dproptxt) "_lt" (nth 4 dproptxt) "_lw" (nth 5 dproptxt) "") ); end progn ); end if ); end progn ); end if (setq segLst(cdr segLst)); end setq ); end while (command "_.erase" lEnt "") (asmi-LayersStateRestore stLst) ); end progn ); end if ); end of Body Function (defun *error*(msg) (if actDoc (vla-EndUndoMark actDoc) ); end if (setvar "CMDECHO" 0) (command "_.undo" "1") (if oldVars (mapcar 'setvar '("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE" "CLAYER" "CECOLOR" "CELTYPE" "CELWEIGHT") oldVars); end mapcar ); end if (if (not (member msg '("console break" "Function cancelled" "quit / exit abort" ""))) (princ (strcat "\nError: " msg)) (princ) ) ); end of *error* (PipeMLineStyle) (setq oldVars(mapcar 'getvar '("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE" "CLAYER" "CECOLOR" "CELTYPE" "CELWEIGHT")) ); end setq (if(entlast)(setq lObj(entlast))) (vla-StartUndoMark (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (not (member dpipeelb '("Mitered" "Radius" "Segmented" "Chamfered"))) (progn (initget "Mitered Radius Segmented Chamfered") (setq dpipeelb (getkword (strcat "\nSpecify elbow type " (if (= dlastelb "Chamfered") "<Chamfered>/" "Chamfered/") (if (= dlastelb "Mitered") "<Mitered>/" "Mitered/") (if (= dlastelb "Segmented") "<Segmented>/" "Segmented/") (if (not (member dlastelb '("Chamfered" "Mitered" "Segmented"))) (strcat "<" (setq dlastelb "Radius") ">: ") "Radius: "))) ) ) ) (if (not (member dpipeelb '("Chamfered" "Mitered" "Radius" "Segmented"))) (setq dpipeelb dlastelb)) (if (/= "Radius" dpipeelb "Segmented") (setq dpipetan dpipeert) (setq dpiperad dpipeert)) (if (not (and (numberp dlastpwd) (< 0 dlastpwd))) (setq dlastpwd (if (= (getvar "MEASUREMENT") 0) 6.0 100.0))) (if (/= (type dlastsuf) 'STR) (setq dlastsuf (if (= (getvar "MEASUREMENT") 0) "x6" "x100"))) (if (/= "Radius" dpipeelb "Segmented") (if (not (and (numberp dpipetan) (< 0 dpipetan))) (progn (initget 6) (setq dpipetan (getdist (strcat "\nSpecify " (if (= dpipeelb "Mitered") "elbow throat" "diagonal chamfer") " length <" (rtos (if (not (and (numberp dlasttan) (< 0 dlasttan))) (setq dlasttan (if (= (getvar "MEASUREMENT") 0) 6.0 (if (= dpipeelb "Mitered") 100.0 150.0))) dlasttan)) ">: ")) ) (if (not (and (numberp dpipetan) (< 0 dpipetan))) (setq dpipetan dlasttan)) ) ) (while (not (or (and (numberp dpiperad) (< 0 dpiperad)) (and (= (type dpiperad) 'STR) (< 0 (distof dpiperad))))) (initget 6 "Throat R÷w(d)") (setq dpiperad (getdist (strcat "\nSpecify radius [" (if (and (= (type dpiperad) 'STR) (< 0 (distof dpiperad))) "<Throat>/R÷w(d)] <" "Throat/<R÷w(d)>] <") (cond ((and (numberp dlastrad) (< 0 dlastrad)) (rtos dlastrad)) ((and (= (type dlastrad) 'STR) (< 0 (distof dlastrad))) (rtos (distof dlastrad) 2)) (T (rtos (setq dlastrad (if (= (getvar "MEASUREMENT") 0) 6.0 100.0))))) ">: ")) ) (cond ((= dpiperad "Throat") (setq dpiperad nil dlastrad (if (numberp dlastrad) dlastrad (* (- (distof dlastrad) 0.5) dlastpwd)))) ((= dpiperad "R÷w(d)") (setq dpiperad nil dlastrad (if (numberp dlastrad) (rtos (* (/ dlastrad dlastpwd) 1.5) 2) dlastrad))) ((numberp dpiperad) (setq dpiperad (if (numberp dlastrad) dpiperad (rtos dpiperad 2)))) (T (setq dpiperad dlastrad)) ) ) ) (if (not (and (numberp dpipetrn) (<= 0 dpipetrn (/ PI 2.0)))) (setq dpipetrn (getangle (strcat "\nSpecify transition angle <" (angtos (if (and (numberp dlasttrn) (<= 0 dlasttrn (/ PI 2.0))) dlasttrn (setq dlasttrn (/ PI 6.0))) 0) ">: ")) ) ) (if (not (and (numberp dpipetrn) (<= 0 dpipetrn (/ PI 2.0)))) (setq dpipetrn dlasttrn)) (if (not (member dpipepat '("All" "Straight" "None"))) (progn (initget "All Straight None") (setq dpipepat (getkword (strcat "\nSpecify segments to hatch " (if (= dlastpat "All") "<All>/" "All/") (if (= dlastpat "Straight") "<Straight>/" "Straight/") (if (/= "All" dlastpat "Straight") (strcat "<" (setq dlastpat "None") ">: ") "None: "))) ) ) ) (if (not (member dpipepat '("All" "Straight" "None"))) (setq dpipepat dlastpat)) (if (not (member dpipecln '(0 1 2 3))) (progn (initget "Yes No") (setq dpipecln (getkword (strcat "\nWould you like to have centerline shown? <" (if (not (/= 1 dlastcln 3)) "Y>" (progn (setq dlastcln (if (= dlastcln 2) 2 0))"N>")))) ) (cond ((= dpipecln "Yes")(setq dpipecln (logior dlastcln 1))) ((= dpipecln "No") (setq dpipecln (logand dlastcln -2))) (T (setq dpipecln dlastcln)) ) (if (and (= (logand dpipecln 1) 1) (/= "Chamfered" dpipeelb "Mitered")) (progn (initget "Yes No") (setq dpipecln (getkword (strcat "\nWould you like elbow centerlines filleted? <" (if (= (logand dlastcln 2) 2) "Y>" "N>"))) ) (cond ((= dpipecln "Yes")(setq dpipecln 3)) ((= dpipecln "No") (setq dpipecln 1)) (T (setq dpipecln (logior dlastcln 1))) ) ) ) ) ) (if (not (member dpipecln '(0 1 2 3))) (setq dpipecln dlastcln)) (if (/= (type dpipesuf) 'STR) (progn (initget "Yes No") (setq dpipesuf (getkword (strcat "\nWould you like to have size label shown? <" (if (and (= (type dlastsuf) 'STR) (/= " " dlastsuf)) "Y>" (progn (if (/= (type dlastsuf) 'STR) (setq dlastsuf " "))"N>")))) ) (cond ((= dpipesuf "Yes")(setq dpipesuf (if (/= " " dlastsuf) dlastsuf ""))) ((= dpipesuf "No") (setq dpipesuf " ")) (T (setq dpipesuf dlastsuf)) ) ) ) (if (/= (type dpipesuf) 'STR) (setq dpipesuf dlastsuf) (setq dlastsuf dpipesuf)) (if (not (and (numberp dpipepwd) (< 0 dpipepwd))) (setq dpipepwd dlastpwd) (setq dlastpwd dpipepwd)) (if (or (/= (type dpropobj) 'LIST) (not (equal (mapcar 'type dpropobj) '(STR STR STR STR)))) (setq dpropobj '("" "" "" ""));objectline properties format '("layer" "color" "ltype" "lweight") ) (setvar "CMDECHO" 0) (if (and (read (caddr dpropobj)) (not (member (strcase (caddr dpropobj)) '("BYBLOCK" "BYLAYER" "CONTINUOUS"))) (not (tblsearch "LTYPE" (caddr dpropobj)))) (command "_.linetype" "_l" (caddr dpropobj) (findfile (nth (getvar "MEASUREMENT") '("acad.lin" "acadiso.lin"))) "") ) (command "_.clayer" (nth 0 dpropobj) "_.cecolor" (nth 1 dpropobj) "_.celtype" (nth 2 dpropobj) "_.celweight" (nth 3 dpropobj)) (while (not (and (numberp dpipepWd) (< 0 dpipepWd) (= 'LIST (type dpipefpt)) (<= 2 (length dpipefpt) 3) (apply 'and (mapcar 'numberp dpipefpt)))) (if (/= " " dpipesuf) (progn (initget 128 "Suffix Width") (setq dlastfpt (getpoint (strcat "\nSpecify start point or [Width/Suffix] <" (rtos dlastpWd (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) (vl-string-subst "Ø" "%%C" (vl-string-subst "Ø" "%%c" dlastsuf)) ">: " )) ); end setq ) (setq dlastfpt (getpoint (strcat "\nSpecify start point or width <" (rtos dlastpWd (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) ">: " )) ); end setq ) (cond ((and (= 'LIST (type dlastfpt)) (<= 2 (length dlastfpt) 3) (apply 'and (mapcar 'numberp dlastfpt))) (setq dpipefpt dlastfpt) ); end condition #1 ((and (= 'REAL (type (distof dlastfpt))) (< 0 (distof dlastfpt))) (setq dpipepWd (distof dlastfpt) dlastpWd dpipepWd); end setq ); end condition #2 ((= dlastfpt "Width") (initget 128) (setq dpipepWd (getdist (strcat "\nSpecify starting width <" (rtos dlastpWd (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) ">: ")) dlastpWd dpipepWd); end setq ); end condition #3 ((= dlastfpt "Suffix") (initget 128) (setq dpipesuf (getstring (strcat "\nEnter text for suffix <" (vl-string-subst "Ø" "%%C" (vl-string-subst "Ø" "%%c" dlastsuf)) ">: " )) dlastsuf dpipesuf); end setq ); end condition #4 (T (princ "\nInvalid option keyword! ") ); end condition #5 ); end cond ); end while (mapcar 'setvar '("FILLMODE" "PLINEWID" "CMDECHO") (list 0 dpipepWd 0)) (setq ERRENT (entlast)) (command "_.pline" dpipefpt) (setq DLP (list dpipefpt)) (while (= (getvar "CMDNAMES") "PLINE") (setvar "CMDECHO" 0) (initget (strcat "Width " (if (/= " " dpipesuf) "Suffix " "") "Undo")) (setq PNT (getpoint (last DLP) (strcat "\nSpecify next point" (if (>= (length DLP) 2) (strcat " or [undo/Width" (if (/= " " dpipesuf) "/Suffix" "") "]") "") ": "))) (cond ((/= (getvar "CMDNAMES") "PLINE")) ((= PNT "Width") (setq PWD (getvar "PLINEWID")) (princ (strcat "\nSpecify ending width <" (rtos (getvar "PLINEWID") (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) ">: ")) (command "_Width" "" PAUSE) (cond ((or (= PWD (getvar "PLINEWID")) (<= (distof (angtos dpipetrn 0 16)) 0) (> (distof (angtos dpipetrn 0 16)) 90))) ((= (distof (angtos dpipetrn 0 16)) 90) (setq PWD (getvar "PLINEWID")) (command (getvar "LASTPOINT") "_u" (getvar "LASTPOINT") "_w" PWD PWD) ) (T (command (last (setq DLP (append DLP (list (polar (getvar "LASTPOINT") (angle (cadr (reverse DLP)) (last DLP)) (/ (abs (- PWD (getvar "PLINEWID"))) 2.0 (/ (sin dpipetrn) (cos dpipetrn)))))))) ) ) ) ) ((= PNT "Suffix") (initget 128) (setq dpipesuf (getstring (strcat "\nEnter text for suffix <" (vl-string-subst "Ø" "%%C" (vl-string-subst "Ø" "%%c" dlastsuf)) ">: " )) ) (if (/= dpipesuf dlastsuf) (progn (mapcar 'set '(dpipesuf dlastsuf) (list dlastsuf dpipesuf)) (setq dlastpwd (getvar "PLINEWID") dlastfpt (last DLP) DLP (list dlastfpt) ) (while (= (getvar "CMDNAMES") "PLINE") (command "")) (BodyFunction) (setq dpipesuf dlastsuf) (setvar "PLINEWID" dlastpwd) (command "_.pline" dlastfpt) ) ) ) ((= PNT "Undo") (command "_Undo") (setq DLP (reverse (cdr (reverse DLP)))) ) ((and (= 'LIST (type PNT)) (<= 2 (length PNT) 3) (apply 'and (mapcar 'numberp PNT))) (command PNT) (setq DLP (append DLP (list PNT))) ) ((command PNT)) ) ) ; (while (= (getvar "CMDNAMES") "PLINE") ; (setvar "CMDECHO" 0) ; (princ (strcat "\nSpecify next point" (if (>= (length DLP) 2) " or [undo/Width/Suffix]" "") ": ")) ; (command PAUSE) ; (initget "Width Suffix Undo") ; (getpoint (last DLP) (strcat "\nSpecify next point" (if (>= (length DLP) 2) " or [undo/Width/Suffix]" "") ": ")) ; (cond ; ((/= (getvar "CMDNAMES") "PLINE")) ; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: W,*: W[i ],*: WI[D ],*: WID[T ],*: WIDTH,*: WIDTH ")) ; (setq PWD (getvar "PLINEWID")) ; (princ (strcat "\nSpecify ending width <" (rtos (getvar "PLINEWID") (if (= (getvar "DIMLUNIT") 4) 5 (getvar "DIMLUNIT"))) ">: ")) ; (command "" PAUSE) ; (cond ; ((or (= PWD (getvar "PLINEWID")) (<= (distof (angtos dpipetrn 0 16)) 0) (> (distof (angtos dpipetrn 0 16)) 90))) ; ((= (distof (angtos dpipetrn 0 16)) 90) ; (setq PWD (getvar "PLINEWID")) ; (command (getvar "LASTPOINT") "_u" (getvar "LASTPOINT") "_w" PWD PWD) ; ) ; (T ; (command (last (setq DLP (append DLP (list (polar (getvar "LASTPOINT") (angle (cadr (reverse DLP)) (last DLP)) ; (/ (abs (- PWD (getvar "PLINEWID"))) 2.0 (/ (sin dpipetrn) (cos dpipetrn)))))))) ; ) ; ) ; ) ; ) ; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: S,*: S[u ],*: SU[F ],*: SUF[F ],*: SUFF[i ],*: SUFFI[X ],*: SUFFIX ")) ; (initget 128) ; (setq dpipesuf (getstring (strcat "\nEnter text for suffix <" (vl-string-subst "Ø" "%%C" (vl-string-subst "Ø" "%%c" dlastsuf)) ">: " )) ; dlastsuf dpipesuf ; ) ; ) ; ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: U,*: UN,*: UND,*: UNDO")) ; (setq DLP (reverse (cdr (reverse DLP)))) ; ) ; ((setq DLP (append DLP (list (getvar "LASTPOINT"))))) ; ) ; ) (setq dlastpwd (getvar "PLINEWID")) (BodyFunction) (vla-EndUndoMark actDoc) (mapcar 'setvar '("FILLMODE" "PLINEWID" "HPANG" "HPSCALE" "HPNAME" "CMDECHO" "OSMODE") oldVars); end apply (command "_.regen") (setq dlastelb dpipeelb dlasttan dpipetan dlastrad dpiperad dlasttrn dpipetrn dlastpat dpipepat dlastcln dpipecln dlastsuf dpipesuf) (princ) ); end of ductmain (defun c:ductmain() (ductmain nil nil nil nil nil nil nil nil) ) Quote
benhubel Posted August 21, 2017 Posted August 21, 2017 I don't know much about what this routine is doing since my AutoCAD is throwing errors when I try to run it. It appears, however, that what you're looking for is found on line 521: (command "_.text" "_s" (nth 0 dproptxt) "_j" "_mc" (mapcar '/ (mapcar '+ plStart1 plEnd) '(2.0 2.0 2.0))) Currently it's using the text command. It just needs to be changed to utilize the mtext command. One difficulty is that the two take different arguments. I can't fully test it myself, but my guess is that you can change that line to something along the lines of: (command "_.mtext" plStart1 "_s" (nth 0 dproptxt) "_j" "_mc" plEnd) or something similar. I hope that this is at least enough to get you started. Quote
benhubel Posted August 21, 2017 Posted August 21, 2017 (edited) Hmm, it looks like I'm in over my head as well. It appears as if line 525 is already generating mtext. Whoever wrote this code seemed to include that functionality. I'd have to see what the code does before I can really tell what part needs fixing. Perhaps there's a variable setting that can be adjusted to use the proper text object type? Also, I completely glossed over the color part. The variable dproptxt seems to hold the color information, (nth 3 dproptext) specifically. Setting it to 2 should cause things to default to yellow. Edited August 21, 2017 by benhubel Got the wrong index for the color yellow... long day Quote
BIGAL Posted August 22, 2017 Posted August 22, 2017 A couple of things the code appears to be written by ASMI but there is not any acknowledgement in the code headers etc. Its a lot of code to check but changing to mtext the main thing is with the colour it can be by layer or a colour. {\fArial|b0|i0|c0|p34;\C1;This is arial red Colour 1} so you need to make the mtext and change the colour setting in the text string. I know I and lee-mac did some stuff about changing the colour will try to find its posted here. Quote
danleebank Posted August 22, 2017 Author Posted August 22, 2017 Benhubel, Thanks for looking into it. What errors are you getting? The command for using the lisp once loaded is DuctMain. As far as the (nth 3 dproptxt) code goes, doing a find and replace using word.... there appears to be a lot of areas with this code using numbers other than 3 as well which is a bit confusing since the text is indeed red when I run the lisp. BIGAL, Hi, Is ASMI a user? I would gladly add an acknowledgment if i knew who to credit. I found the code being offered as "wpipe12" free to use on another site. About the red arial text, i believe that is a back up if the program cannot find a current textstyle. Whats interesting is that it adopts the style i have predefined in the drawing (when i click the created text and choose properties it says the name of the style) however it is a MTEXT style, but none the less it has the correct font (simplex) just as a regular text. The main issue is that without Mtext, there is no Mtext editor. Thanks for the help! Quote
BIGAL Posted August 23, 2017 Posted August 23, 2017 http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools Quote
Recommended Posts
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.