重复或循环
大家好，我已经想出了合并我的三个Lisp rputine，但它仍然需要工作，我需要重复例程的最后一部分，直到右键单击，我不知道这让我发疯。谁能帮帮我吗。还有一种方法可以使用例程第一部分的结果来运行例程的其余部分吗？
谢谢，布莱恩
(defun c:test1( / 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
(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
(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)) 5.38)) (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)))
)
(princ)
嗨，布莱恩，
您似乎很好地处理了自动/可视lisp函数。你能解释一下你的计划到底想实现什么吗？
当做
杰米 我想我认出了一些密码
http://www.cadtutor.net/forum/showthread.php?36659-lisp将带有pline leangth的文本放在第行上方，p=241565，viewfull=1#post241565
哇！那太老了。。。 你好
当lisp例程运行时，它可以很好地完成前两部分，但当它到达最后一部分时，它只允许我选择一行，然后结束命令，我想做的是选择需要的行，然后右键单击命令。任何想法。 嗨，李
是的，李，它确实是PLLEN的一部分。你很久以前写的lsp例程。多亏了像你这样的人，我们新手可以学习如何编写适合我们需要的例程。非常感谢李。
布瑞恩 我同意你的观点！http://www.cadtutor.net/forum/showthread.php?756-偏移多个对象
Brian，如果你从别人那里获取代码，你应该发布一个简短的通知。人们花时间免费提供日常活动，至少把自己的名字留给子孙后代。 你好
我无意冒犯任何人。当我将它们组合在一起时，我只使用了与lisp例程的函数相关的行。许多道歉。我以后会记住这一点。
布瑞恩 没有冒犯，这只是一句友好的警告。如果你将来能记住这一点，那就好了。
Brian，fuccaro和Lee都是多年来为帮助本网站和其他地方的其他人贡献了大量代码、专业知识和精力的领军人物。大概你也注意到了fuccaro发布的代码眨眼： 谢谢爸爸！
我认为我们可以考虑这个问题属于过去。我刚刚在这里发布了一个关于版权的帖子链接，现在我自己认为这个话题已经结束了。
页:
[1]