danleebank 发表于 2022-7-5 16:06:07

帮助创建多行文字与文字

大家好,
 
我有一个lisp,除了它如何生成文本外,它工作得很好。目前,它创建的标签是普通文字和当前图层上的红色,但我们的公司标准要求多行文字。此外,对于黄色的多行文字和图层上的M_文字(使用此lisp时应已定义)
 
我需要一些帮助来理解这一点。我已经能够创建一些简单的Lisp程序,但理解这一个,我在一个有点超过我的头。lisp将创建管网并在直线段中放置标签。
 
我最大的目标是让它生成多行文字,然后颜色会很好,然后图层将是最后一个优先级,因为它很容易选择相似的内容并移动它。
 
你们能帮帮我吗?
 

(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 <"
                        (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 ") "") ": ")))
(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 " "") ": "))
;        (command PAUSE)
;        (initget "Width Suffix Undo")
;        (getpoint (last DLP) (strcat "\nSpecify next point" (if (>= (length DLP) 2) " or " "") ": "))
;        (cond
;                ((/= (getvar "CMDNAMES") "PLINE"))
;                ((and (equal (getvar "LASTPOINT") (last DLP)) (wcmatch (strcase (getvar "LASTPROMPT")) "*: W,*: W,*: WI,*: WID,*: 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,*: SU,*: SUF,*: SUFF,*: SUFFI,*: 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)
)

benhubel 发表于 2022-7-5 16:26:37

我不知道这个例程在做什么,因为我的AutoCAD在运行它时会出错。
然而,您要查找的内容似乎位于第521行:
 
(command "_.text" "_s" (nth 0 dproptxt) "_j" "_mc" (mapcar '/ (mapcar '+ plStart1 plEnd) '(2.0 2.0 2.0)))
 
目前它正在使用text命令。只需更改它即可使用mtext命令。一个困难是,这两种观点不同。我自己不能完全测试它,但我想你可以把这一行改成以下几行:
 
(command "_.mtext" plStart1 "_s" (nth 0 dproptxt) "_j" "_mc" plEnd)
 
或者类似的东西。我希望这至少足以让你开始。

benhubel 发表于 2022-7-5 16:32:30

嗯,看起来我也有点过头了。似乎第525行已经在生成多行文字。无论是谁编写了这段代码,似乎都包含了这一功能。我必须先看看代码做了什么,然后才能真正判断哪些部分需要修复。也许有一个变量设置可以调整为使用正确的文本对象类型?
 
此外,我完全掩盖了颜色部分。变量dproptxt似乎具体包含颜色信息(nth 3 dproptext)。将其设置为2会导致默认为黄色。

BIGAL 发表于 2022-7-5 16:49:52

有几件事代码似乎是由ASMI编写的,但在代码头中没有任何确认信息等。需要检查的代码很多,但更改为多行文字。主要的是颜色,可以按层或颜色。{\fArial | b0 | i0 | c0 | p34;\C1;这是宋体红色1},因此您需要制作多行文字并更改文本字符串中的颜色设置。我知道我和李做了一些关于改变颜色的事情,我会努力找到它张贴在这里。

danleebank 发表于 2022-7-5 16:54:21

Benhubel,
 
谢谢你调查。你犯了什么错误?加载后使用lisp的命令是DuctMain。
 
至于(nth 3 dproptxt)代码,使用word进行查找和替换。。。。这段代码似乎有很多地方也使用了3以外的数字,这有点令人困惑,因为当我运行lisp时,文本确实是红色的。
 
比加尔,
 
嗨,ASMI是用户吗?如果我知道该归功于谁,我很乐意再加上一句致谢。我发现代码以“wpipe12”的形式提供,可以在另一个站点上免费使用。
 
关于红色arial文本,如果程序无法找到当前的文本样式,我相信这是一个备份。有趣的是,它采用了我在图形中预定义的样式(当我单击创建的文本并选择“属性”时,它会显示样式的名称),但是它是多行文字样式,但它的字体(单纯形)与普通文本一样正确。主要问题是,没有多行文字,就没有多行文字编辑器。
 
谢谢你的帮助!

BIGAL 发表于 2022-7-5 17:11:52

http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools公司
页: [1]
查看完整版本: 帮助创建多行文字与文字