帮助创建多行文字与文字
大家好,我有一个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)
)
我不知道这个例程在做什么,因为我的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)
或者类似的东西。我希望这至少足以让你开始。 嗯,看起来我也有点过头了。似乎第525行已经在生成多行文字。无论是谁编写了这段代码,似乎都包含了这一功能。我必须先看看代码做了什么,然后才能真正判断哪些部分需要修复。也许有一个变量设置可以调整为使用正确的文本对象类型?
此外,我完全掩盖了颜色部分。变量dproptxt似乎具体包含颜色信息(nth 3 dproptext)。将其设置为2会导致默认为黄色。 有几件事代码似乎是由ASMI编写的,但在代码头中没有任何确认信息等。需要检查的代码很多,但更改为多行文字。主要的是颜色,可以按层或颜色。{\fArial | b0 | i0 | c0 | p34;\C1;这是宋体红色1},因此您需要制作多行文字并更改文本字符串中的颜色设置。我知道我和李做了一些关于改变颜色的事情,我会努力找到它张贴在这里。 Benhubel,
谢谢你调查。你犯了什么错误?加载后使用lisp的命令是DuctMain。
至于(nth 3 dproptxt)代码,使用word进行查找和替换。。。。这段代码似乎有很多地方也使用了3以外的数字,这有点令人困惑,因为当我运行lisp时,文本确实是红色的。
比加尔,
嗨,ASMI是用户吗?如果我知道该归功于谁,我很乐意再加上一句致谢。我发现代码以“wpipe12”的形式提供,可以在另一个站点上免费使用。
关于红色arial文本,如果程序无法找到当前的文本样式,我相信这是一个备份。有趣的是,它采用了我在图形中预定义的样式(当我单击创建的文本并选择“属性”时,它会显示样式的名称),但是它是多行文字样式,但它的字体(单纯形)与普通文本一样正确。主要问题是,没有多行文字,就没有多行文字编辑器。
谢谢你的帮助! http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools公司
页:
[1]