[编程交流] 帮助创建多行文字与文字

(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)
)

(command "_.text" "_s" (nth 0 dproptxt) "_j" "_mc" (mapcar '/ (mapcar '+ plStart1 plEnd) '(2.0 2.0 2.0)))

(command "_.mtext" plStart1 "_s" (nth 0 dproptxt) "_j" "_mc" plEnd)