组合三个lisp例程int
大家好，我需要一些帮助，我有三个lisp例程，我想合并成一个例程。它们都使用相同的对象来获得结果，所以我想知道是否有方法将它们结合在一起。其顺序如下：
1.olo（偏移多段线）
2.exl（拉伸长度）我看到的唯一一点是，它需要使用输入进行放置，我希望它将结果放置在线的外侧。通过创建一个分解的矩形来运行lisp例程，看看它做了什么。
3.pte（面板标签扩展）
它们都能自己完美运行，但我只是想加快进程。这是我正在使用的代码。任何帮助都将不胜感激。
谢谢
布瑞恩
;| OFFSET POLYLINES
mfuccaro@hotmail.com September 2003
|;
(defun c:olo( / plines ; selection set of polylines
ext ; extrnal point
dist ; distance to offset
poly ; a polyline from plines
plist ; the list of poly
del ; polyline to delete
int ; internal point
i)
(command "undo" "begin")
(princ "select polylines")
(setq plines (ssget)
i 0
ext (getvar "limmax")
dist (getdist (strcat "distance <" (if olddist
(rtos olddist) ;use old value as default
"") ">")))
(if (not dist) (setq dist olddist)) ;reuse old distance if user press <Enter>
(repeat (sslength plines)
(setq poly (ssname plines i))
(setq plist (entget poly))
(command "offset" dist poly ext "")
(setq del (entlast)
int (polar
(cdr (assoc 10 (entget del)))
(angle
(cdr (assoc 10 (entget del)))
(cdr (assoc 10 plist)))
(* 2 (distance (cdr (assoc 10 plist))
(cdr (assoc 10 (entget del)))))))
(command "offset" dist poly int "")
(command "_.change" (entlast) "" "_p" "_la" (getvar 'clayer) "")
(entdel del)
(setq i (1+ i)))
(command "undo" "end")
(setq olddist dist) ;preserve current distance for next run
(princ)
)
;Extrusion Length
(defun c:EXTL (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4)
(vl-load-com)
(if (and (setq cEnt (car (entsel "\nSelect Object: ")))
(member (cdr (assoc 0 (entget cEnt)))
'("LWPOLYLINE" "POLYLINE" "LINE")))
(progn
(setq tStr (strcat "1@" (rtos (- (vla-get-length
(vlax-ename->vla-object cEnt)) 4.0)) (strcat "''"))
tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
tHgt (- (cadadr tBox) (cadar tBox))
twid (- (caadr tBox) (caar tBox)))
(princ "\nPosition Text...")
(while (eq 5 (car (setq gr (grread t 5 0))))
(redraw)
(if (listp (setq sPt (cadr gr)))
(progn
(setq cPt(vlax-curve-getClosestPointto cEnt sPt)
lAng (angle cPt sPt)
bpt(polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
tpt(polar bpt lAng tHgt)
mPt(polar bPt lAng (/ tHgt 2.))
pt1(polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
pt2(polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
pt3(polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
pt4(polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
(grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
(if (eq 3 (car gr))
(progn
(setq lAng (- lAng (/ pi 2.)))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(Make_Text mPt tStr lAng))))
(princ "\n<!> Incorrect Selection <!>"))
(redraw)
(princ))
(defun Make_Text(pt val rot)
(entmake
(list
(cons 0 "TEXT")
(cons 8 (getvar "CLAYER"))
(cons 62 1)
(cons 10 pt)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 val)
(cons 50 rot)
(cons 7 (getvar "TEXTSTYLE"))
(cons 71 0)
(cons 72 1)
(cons 73 2)
(cons 11 pt))))
;;; PANEL TAB EXTENSIONS
(defun c:PTE(/ lSet actDoc lDel doMode objLst)
(vl-load-com)
(princ "\n>>> Select lines to extend/reduce <<< ")
(if
(and
(setq lSet
(ssget
'((0 . "LINE"))));
(setq lDel
(getreal "\nSpecify : "))
); end and
(progn
(initget 1 "Positive Negative Both")
(setq doMode
(getkword "\nSpecify direction : ")
objLst(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex lSet))))); end setq
(vla-StartUndoMark
(setq actDoc
(vla-get-ActiveDocument
(vlax-get-acad-object)))); end vla-StartUndoMark
(if(member doMode '("Negative" "Both"))
(foreach ln objLst
(vlax-put ln 'startpoint
(polar
(vlax-get ln 'startpoint)
(vlax-get ln 'angle)(- lDel))); end vlax-put
); end foreach
); end if
(if(member doMode '("Positive" "Both"))
(foreach ln objLst
(vlax-put ln 'endpoint
(polar
(vlax-get ln 'endpoint)
(vlax-get ln 'angle)lDel))
); end foreach
); end if
(vla-EndUndoMark actDoc)
); end progn
); end if
(princ)
)
页:
[1]