有人能检查这个口齿不清吗
你好Lispers我已经做了一个lisp（不完全是我自己做的，我刚刚编译了许多从网上找到的lisp）。它在行为不端后第一次运行良好。有人能在下面的lisp中找到错误吗？
在命令结束时，如果我退出它，请撤消一步。
请检查此Lisp程序。。
;;;compiled from various lisps. Thanks to all Developers.
;;;compiled by Balaji Subramanian VSL Middle East balaji.indian@yahoo.com
;;;Version 1.0 Inner Tenndon Z-Values Created.
;;;VERSION 1.1 Z-VALUES moved and duplicate lines deleted.
;;;VERSION 1.2 Z-VALUES ALIGNED AT EQUAL SPACING
(defun *error* (errmsg)
(princ "\nAn error has occurred in the programme. ")
(terpri)
(prompt errmsg)
(princ)
)
(defun trap1 (errmsg) ;define function
(command "u" "b") ;undo back
(setvar "osmode" oldsnap) ;restore variables
(setvar "clayer" oldlayer)
(setvar "cmdecho" oldecho)
(setq *error* temperr) ;restore *error*
(prompt "\nResetting System Variables ") ;inform user
(princ)
)
(defun texAlign (item /)
(if(= daly:Direct "Y")
(progn
(setq disDelta(- disDelta daly:strDis)) ; end setq
(vla-put-Alignment (car str) tAlignment)
(cond
((= tAlignment 0)
(vla-put-InsertionPoint (car str)
(vlax-3D-Point(car insPoint)
(+ disDelta(cadr insPoint))(nth 2 insPoint)))
)
((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14))
(vla-put-TextAlignmentPoint (car str)
(vlax-3D-Point(car tAlignPt)
(+ disDelta(cadr tAlignPt))(nth 2 tAlignPt)))
)
((member tAlignment '(3 5))
(princ "\nCan't align string with Aligned or Fit alignment ")
)
) ; end cond
) ; end progn
(progn
(setq disDelta(- disDelta daly:strDis)) ; end setq
(vla-put-Alignment (car str) tAlignment)
(cond
((= tAlignment 0)
(vla-put-InsertionPoint (car str)
(vlax-3D-Point(-(car insPoint)disDelta)
(cadr insPoint)(nth 2 insPoint)))
)
((member tAlignment '(1 2 4 6 7 8 9 10 11 12 13 14))
(vla-put-TextAlignmentPoint (car str)
(vlax-3D-Point(-(car tAlignPt)disDelta)
(cadr tAlignPt)(nth 2 tAlignPt)))
)
((member tAlignment '(3 5))
(princ "\nCan't align string with Aligned or Fit alignment ")
)
) ; end cond
) ; end progn
) ; end if
) ; end of texAlign
(defun c:iz ()
(vl-load-com)
(setq temperr *error*) ;store *error*
(setq *error* trap1) ;re-assign *error*
(setq oldecho (getvar "cmdecho")) ;store variables
(setq oldlayer (getvar "clayer"))
(setq oldsnap (getvar "osmode"))
(setvar "cmdecho" 0) ;reset variables
(setvar "osmode" 32)
(command "undo" "m")
(command "layer" "make" "Z-VALUES" "color" "5" "" "")
(princ "\nSelect Outer Tendon: ")
(setq ten2 (ssget))
(princ "\nSelect Inner Tendon: ")
(setq ten1 (ssget))
(princ "\n>> Select Points >>")
(setvar "osmode" 0)
(if (setq i -1 ss (ssget '((0 . "POINT")))) ;IF STARTS HERE
(if (and (setq ent (car (entsel "\nSelect Reference Line: ")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,CIRCLE,ELLIPSE,ARC"))
(while (setq pt (ssname ss (setq i (1+ i))))
(setq p2 (vlax-curve-getClosestPointtoprojection ent
(setq p1 (cdr (assoc 10 (entget pt)))) '(0 0 1)))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))))) ;IF ENDS HERE
(setq ssetzv (ssget "X" '((0 . "LINE")(8 . "Z-VALUES"))))
(command "EXTEND" ten2 "" ssetzv "")
(command "TRIM" ten1 "" ssetzv "" )
(terpri)
(prompt "\nSelect Z-Value lines: ")
(setvar "OSMODE" 32)
(setq ss1 (ssget "X" '((0 . "LINE")(8 . "Z-VALUES"))))
(setvar "OSMODE" 0)
(progn ;PROG1 STARTS HERE
(setq count 0)
(repeat (sslength ss1) ;REPEAT STARTS HERE
(setq cont (entget (ssname ss1 count)))
(if (= "LINE" (cdr (assoc 0 cont))) ;IF STARTS HERE
(progn ;PROG2 STARTS HERE
(setq CONST_txt-ht 250.0
CONST_style "Standard"
layer (cdr (assoc 8 cont))
ip (cdr (assoc 10 cont))
rot (angle (cdr (assoc 10 cont)) (cdr (assoc 11 cont)))
dist (distance (cdr (assoc 10 cont)) (cdr (assoc 11 cont)))
ent (list ;LIST STATS HERE
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 ip)
(cons 40 CONST_txt-ht)
(cons 41 1)
(cons 72 0)
(cons 1 (rtos dist 2))
(cons 7 CONST_style)
(list 210 0.0 0.0 1.0)
(cons 11 (cdr (assoc 11 cont)))
(cons 50 rot))
)
(entmake ent)
) ;PROG2 ENDS HERE
) ;IF ENDS HERE
(setq count (1+ count))
) ;REPEAT ENDS HERE
) ;PROG1 ENDS HERE
(setq tSet(ssget "X" '((0 . "TEXT")(8 . "Z-VALUES")))) ;select texts
(setq mpt1 '(0 0)) ;moving orgin
(setq mpt2 (polar mpt1 (/ pi 2) 40000)) ;momving location
(command "MOVE" tSet "" mpt1 mpt2 "") ;move command
(if (setq deli(ssget "X" '((0 . "LINE")(8 . "Z-VALUES")))) ;selecting z-vzlues lines
(progn
(command "ERASE" deli ""))) ;delete lines
(if(not daly:Direct)(setq daly:Direct "Y"))
(setq oldDirect daly:Direct)
(if(not daly:Align)(setq daly:Align "H"))
(setq oldAlign daly:Align)
(if(not daly:disMode)(setq daly:disMode "S"))
(setq oldDisMode daly:disMode)
(if(not daly:strDis)(setq daly:strDis 1000))
(setq oldStrDis daly:strDis)
(initget "Y X")
(setq daly:Direct
(getkword
(strcat "\nSpecify alignment direction <"daly:Direct">: ")))
(if(null daly:Direct)(setq daly:Direct oldDirect))
(initget "H L C M R TL TC TR ML MC MR BL BC BR")
(setq daly:Align
(getkword
(strcat "\nSpecify justification <"daly:Align">: "))
alignList '(("L" 0)("C" 1)("R" 2)("M" 4)("TL" 6)("TC" 7)("TR" ("ML" 9)("MC" 10)("MR" 11)("BL" 12)("BC" 13)("BR" 14))
) ; end setq
(if(null daly:Align)(setq daly:Align oldAlign))
(initget "S C")
(setq daly:disMode
(getkword
(strcat "\nSpecify distance between strings <"daly:disMode">: ")))
(if(null daly:disMode)(setq daly:disMode oldDisMode))
(if(= daly:disMode "C")
(progn
(setq daly:strDis(getdist(strcat "\nSpecify Custom distance <"(rtos daly:strDis)">: ")))
(if(null daly:strDis)(setq daly:strDis oldStrDis))
(princ(strcat "\nCustom distance is "(rtos daly:strDis)))
) ; end progn
) ; end if
(while T
(princ "\n<<< Select DText and press Enter or Esc to Quit >>> ")
(if
(setq dtSet(ssget '((0 . "TEXT")(8 . "Z-VALUES"))))
(progn
(if(= "Y" daly:Direct)
(setq dtList(vl-sort(mapcar
'(lambda (x)(list x
(+(cadr(vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint x))))
(cadr(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint x)))))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex dtSet)))))
(function(lambda(a b)(>(cadr a)(cadr b))))))
(setq dtList(vl-sort(mapcar
'(lambda (x)(list x
(+(car(vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint x))))
(car(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint x)))))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex dtSet)))))
(function(lambda(a b)(<(cadr a)(cadr b))))))
); end if
(setq hitStr(caar dtList))
(if(/= "H" daly:Align)
(progn
(vla-getBoundingBox hitStr 'oldMinPt 'MaxPt)
(foreach lst alignList
(if(=(car lst)daly:Align)
(progn
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-Alignment(list hitStr(cadr lst)))))
(progn
(vla-getBoundingBox hitStr 'minPt 'maxPt)
(vla-move hitStr minPt oldMinPt)
); end progn
); end if
); end progn
); end if
); end foreach
); end progn
); end if
(setq tHeight(vla-get-Height hitStr)
insPoint(vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint hitStr)))
tAlignPt(vlax-safearray->list
(vlax-variant-value
(vla-get-TextAlignmentPoint hitStr)))
tAlignment(vla-get-Alignment hitStr)
dtList(cdr dtList)
disDelta 0.0
); end setq
(if(= daly:disMode "S")(setq daly:strDis(* 4 tHeight)))
(foreach str dtList
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'texAlign (list str))))
(princ)
(setq errFlag T)
); end if
); end foreach
(if errFlag(princ "\n<!> Some Entities on Locked Layer <!>"))
); end progn
(princ "\nStrings isn't selected. ")
); end if
); end while
(setvar "clayer" oldlayer) ;reset variables
(setvar "osmode" oldsnap)
(setvar "cmdecho" oldecho)
(setq *error* temperr)
(princ)
)
您在哪里输入ESC？
真的需要一个dwg来匹配代码。
David nice lisp checker是什么？
>>ALLY，一个Lisp分析器
ALLY v3.0a、AutoLISP调试工具和程序员工作台不再受支持。
非常旧，不幸停产
-大卫
>> ALLY, A Lisp Analyzer
ALLY v3.0a, AutoLISP debugging tools and programmer's workbench is no longer supported.
Very old and unfortunately discontinued
-David
页:
[1]