Lisp编码帮助

foster5476 · 发表于 2022-7-5 16:49:05

你好

第一次在这个论坛发帖得到了很多帮助。似乎无法修复此Lisp程序。不知道它从哪里来

我想做的是用两个LISP，一个产生向上舍入的长度，另一个产生+2，用文本S-。

然后用B-四舍五入和+3做同样的事情。

我可以切换到一个或另一个，但当我创建另一个时，它会接管初始Lisp。我猜这和一个通用变量有关？？

我希望这有意义。任何帮助都将不胜感激。

谢谢

copy

(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()

Cad64 · 发表于 2022-7-5 16:55:37

您的问题已移至Autolisp部分：http://www.cadtutor.net/forum/forumdisplay.php?21-AutoLISP Visual LISP amp DCL

foster5476 · 发表于 2022-7-5 17:01:43

我的错，谢谢。

SLW210 · 发表于 2022-7-5 17:03:46

请阅读代码发布指南，并编辑代码以包含在代码标记（非HTML标记）中。[NOPARSE]

copy

Your Code Here[/NOPARSE]

=

copy

Your Code Here

kpblc · 发表于 2022-7-5 17:11:29

您的代码不完整。我认为问题出在txt1和txt2函数内部。尝试使用以下代码获取文本字符串：

copy

(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

通话样本：

copy

_$ (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"

kpblc · 发表于 2022-7-5 17:13:01

P、为什么不在DIESEL表达式中使用字段呢？

foster5476 · 发表于 2022-7-5 17:17:22

感谢您的回复。

我刚开始编码，对VLA也不太了解。我一直在努力想办法，但没走多远。

foster5476 · 发表于 2022-7-5 17:25:32

有没有一种简单的方法可以将我已经拥有的合并到您编写的代码中？

或者，如果你能为我指出正确的方向进行指导，我将不胜感激。

谢谢

foster5476 · 发表于 2022-7-5 17:27:14

所以我找到了一个小的工作，有一点效果，但现在它的所有回击我。很抱歉，提出了一个旧的帖子，但有人能帮我得到这个代码吗？

我试着让文本显示为“S”-长度四舍五入到最近的英尺加2英尺。以及与文本显示为“B”-完全相同的例程，长度四舍五入到最近的英尺加3英尺。

我花了几个小时想知道如何把这篇文章插入我的文章，但运气不好。

有人能帮我吗？

Lee Mac · 发表于 2022-7-5 17:31:55

发布的代码缺少函数txt1和txt2。

我建议对kpblc发布的代码进行以下修改：

copy

(defun get-text ( ent add prf )
   (strcat prf (rtos (+ add (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) 2 0))
)

[编程交流] Lisp编码帮助

发表回复

精选推荐