Lisp编码帮助
你好第一次在这个论坛发帖得到了很多帮助。似乎无法修复此Lisp程序。不知道它从哪里来
我想做的是用两个LISP，一个产生向上舍入的长度，另一个产生+2，用文本S-。
然后用B-四舍五入和+3做同样的事情。
我可以切换到一个或另一个，但当我创建另一个时，它会接管初始Lisp。我猜这和一个通用变量有关？？
我希望这有意义。任何帮助都将不胜感激。
谢谢
(defun C:scable (/)
(setq echo (getvar "cmdecho")) ;gets current value of screen echo
(setvar "cmdecho" 0) ;sets echo to off
(setq style (getvar "textstyle")) ;gets current value of textstyle
(setvar "textstyle" "STANDARD") ;sets textstyle to STANDARD
(arrowinfo)
(arrowdir1)
(setvar "textstyle" style)
(setvar "cmdecho" echo)
);end defun scable
(defun C:dcable ()
(setq echo (getvar "cmdecho")) ;gets current value of screen echo
(setvar "cmdecho" 0) ;sets echo to off
(setq style (getvar "textstyle")) ;gets current value of textstyle
(setvar "textstyle" "STANDARD") ;sets textstyle to STANDARD
(arrowinfo)
(arrowdir2)
(setvar "textstyle" style)
(setvar "cmdecho" echo)
);end defun dcable
(defun rtd (a)
(/ (* a 180.0) pi)
);DEFUN
(DEFUN arrowinfo ()
(SETQ first (entsel)
slect1 (entget (car first))
pt1 (cadr first)
ang1 (angle (setq pt3 (cdr (assoc '10 slect1)))(setq pt4 (cdr (assoc '11 slect1))))
ang2 ( ANGLE pt1 (setq pt2 (getpoint "\nPICK THE TEXT LOCATION: ")))
ang3 ang1)
(if (or (and (> (sin ang1) 0) (> (cos ang1) 0)) (and (< (sin ang1) 0) (> (cos ang1) 0)))
(setq ang1 ang1)
(setq ang1 (+ PI ang1)))
(if(equal ang3 (* 0.5 pi) 0.00000001) (setq ang1 ang3))
(if(equal ang3 PI 0.00000001) (setq ang1 (+ pi ang3)))
(if(equal ang3 0 0.00000001) (setq ang1 ang3))
);end defun arrowinfo
(defun arrowdir1 ()
(if (> (distance pt1 pt3) (distance pt1 pt4)) (ins1) (ins2))
);end defun arrowdir1
(defun arrowdir2 ()
(if (> (distance pt1 pt3) (distance pt1 pt4)) (ins3) (ins4))
);end defun arrowdir2
(defun ins1()
(Setq old (Getvar "clayer"))
(if (tblsearch "layer" "cab")(Setvar "clayer" "cab")
(command "layer" "M" "cab" "C" "red" "" "")
);end if
(command "insert" "NEW-ARROW" pt4 (getvar "ltscale") "" (rtd (+ PI ang3)))
(if (tblsearch "layer" "TICK22")(Setvar "clayer" "TICK22")
(command "layer" "M" "TICK22" "C" "magenta" "" "")
);end if
(command "insert" "TICK2" pt3 (getvar "ltscale") "" (rtd (+ PI ang3)))
(command "setvar" "clayer" old )
(if (> (- (angle pt4 pt3) (angle pt4 pt2)) 0)
(setq pt2 (polar pt4 (- (angle pt4 pt3) 0.277745) 34.5))
(setq pt2 (polar pt4 (+ (angle pt4 pt3) 0.277745) 34.5))
);end if
(txt1)
);end defun ins1
(defun ins2()
(Setq old (Getvar "clayer"))
(if (tblsearch "layer" "cab")(Setvar "clayer" "cab")
(command "layer" "M" "cab" "C" "red" "" "")
);end if
(command "insert" "NEW-ARROW" pt3 (getvar "ltscale") "" ( rtd ang3))
(if (tblsearch "layer" "TICK22")(Setvar "clayer" "TICK22")
(command "layer" "M" "TICK22" "C" "magenta" "" "")
);end if
(command "insert" "TICK2" pt4 (getvar "ltscale") "" ( rtd ang3))
(command "setvar" "clayer" old )
(if (> (- (angle pt3 pt4) (angle pt3 pt2)) 0)
(setq pt2 (polar pt3 (- (angle pt3 pt4) 0.277745) 34.5))
(setq pt2 (polar pt3 (+ (angle pt3 pt4) 0.277745) 34.5))
);end if
(txt1)
);end defun ins2
(defun ins3()
(Setq old (Getvar "clayer"))
(if (tblsearch "layer" "cab")(Setvar "clayer" "cab")
(command "layer" "M" "cab" "C" "red" "" "")
);end if
(command "insert" "NEW-ARROW" pt4 (getvar "ltscale") "" ( rtd (+ PI ang3)))
(command "insert" "NEW-ARROW" (polar pt4 (angle pt4 pt3) 12) (getvar "ltscale") "" ( rtd (+ PI ang3)))
(if (tblsearch "layer" "TICK22")(Setvar "clayer" "TICK22")
(command "layer" "M" "TICK22" "C" "magenta" "" "")
);end if
(command "insert" "TICK2" pt3 (getvar "ltscale") "" (rtd (+ PI ang3)))
(command "setvar" "clayer" old )
(if (> (- (angle pt4 pt3) (angle pt4 pt2)) 0)
(setq pt2 (polar pt4 (- (angle pt4 pt3) 0.277745) 34.5))
(setq pt2 (polar pt4 (+ (angle pt4 pt3) 0.277745) 34.5))
)
(txt2)
);end defun ins3
(defun ins4() 您的问题已移至Autolisp部分：http://www.cadtutor.net/forum/forumdisplay.php?21-AutoLISP Visual LISP amp DCL 我的错，谢谢。 请阅读代码发布指南，并编辑代码以包含在代码标记（非HTML标记）中。
Your Code Here=
Your Code Here 您的代码不完整。我认为问题出在txt1和txt2函数内部。尝试使用以下代码获取文本字符串：
(vl-load-com)
(defun get-text (ent round-plus prefix)
(if (setq ent (cond ((= (type ent) 'ename) (vlax-ename->vla-object ent))
((= (type ent) 'vla-object) ent)
) ;_ end of cond
) ;_ end of setq
(strcat prefix
(rtos (+ (fix (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent))) round-plus) 2 0)
) ;_ end of strcat
""
) ;_ end of if
) ;_ end of defun
通话样本：
_$ (get-text (car (entsel)) 12. "S+")
"S+1316"
_$ (get-text (car (entsel)) 2. "B-")
"B-1306"
_$ (get-text (car (entsel)) -2. "A*")
"A*1302"
_$ (get-text (car (entsel)) 0. "Current : ")
"Current : 1304" P、 为什么不在DIESEL表达式中使用字段呢？ 感谢您的回复。
我刚开始编码，对VLA也不太了解。我一直在努力想办法，但没走多远。
有没有一种简单的方法可以将我已经拥有的合并到您编写的代码中？
或者，如果你能为我指出正确的方向进行指导，我将不胜感激。
谢谢 所以我找到了一个小的工作，有一点效果，但现在它的所有回击我。很抱歉，提出了一个旧的帖子，但有人能帮我得到这个代码吗？
我试着让文本显示为“S”-长度四舍五入到最近的英尺加2英尺。以及与文本显示为“B”-完全相同的例程，长度四舍五入到最近的英尺加3英尺。
我花了几个小时想知道如何把这篇文章插入我的文章，但运气不好。
有人能帮我吗？
发布的代码缺少函数txt1和txt2。
我建议对kpblc发布的代码进行以下修改：
(defun get-text ( ent add prf )
(strcat prf (rtos (+ add (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) 2 0))
)
页:
[1]
2