嗨，我已经在这个Lisp程序的工作了几天。起初，我的一位同事要求我用Lisp程序评分，我找到了戈登·斯蒂芬斯的Lisp程序评分。结果表明，他们想要一个带有箭头Lisp程序的百分比坡度和/或带有三角形Lisp程序的倾斜坡度。我设法使倾斜Lisp程序的工作，但一年级一直给我带来麻烦。
目前，只要用户选择左边的第一个点和右边的第二个点，我就可以给我右方向的文本。另一个方向要么文字消失，要么文字颠倒，我一直无法找出原因。
我的逻辑或编码哪里出了问题，可以给我一些指导吗？
- (defun c:grade (/ pnt1 pnt2 ang1 ang2 tanofang grade1 midpt osmd txt1 hp1 vp1 hp2 vp2 midapt lpt1 lpt2)
- ; Grade Lisp by Gordon Stephens. Heavily edited to add a dim arrow by Mark Clews with snippets of code from experts like Lee Mac
- ;; clear most command text from commandline
- (setvar "cmdecho" 0)
- ;; Error coding begins
- (defun *error* ( msg )
- (if osm (setvar 'osmode osm))
- (cond ((not msg))
- ((member msg '("Function cancelled" "quit / exit abort")))
- ((princ (strcat "\n*** Error: " msg " ** ")))
- )
- (princ)
- ) ;; End of error Coding
- ;; Set basic variables
- (prompt "\npick points for the grade")
- (setq pnt1 (getpoint) pnt2 (getpoint pnt1))
- ;;If statements to determine angle standard between -90° and +90°
- (setq osmd (getvar "osmode"))
- (setvar "osmode" 0)
- (setq ang1 (angle pnt1 pnt2))
- (setq tanofang (/ (sin ang1) (cos ang1)))
- (if (= tanofang 0) (setq grade1 0.0)
- (setq grade1 (/ 1 tanofang))
- ) ; endif
- ;;Create the Text
- (setq txt1 (strcat (rtos (abs (/ 100 grade1)) 2 1) "%" ))
- (setq midpt (list (/ (+ (car pnt1) (car pnt2)) 2) (+ (/ (+ (cadr pnt1) (cadr pnt2)) 2) 5)))
- ;;Orientation of text If the value of the number from multiplying x and y is positive
- (If (> 0 (- (car pnt1) (car pnt2))) ;this is the one going wrong
- (setq ang2 (rtd ang1))
- ;; Add Text
- (command "text" "mc" midpt 2.5 ang2 txt1) ; middle centre justified
- ) ;;End If
- ;;Orientation of text If the value of the number from multiplying x and y is negative
- (If (< 0 (- (car pnt1) (car pnt2)))
- (setq ang2 (rtd (- ang1 180)))
- ;; Add Text
- (command "text" "mc" midpt 2.5 ang2 txt1) ; middle centre justified
- ) ;;End If
- ;;Create the arrows
- ;;Set independant origin point
- (setq midapt (list (/ (+ (car pnt1) (car pnt2)) 2) (+ (/ (+ (cadr pnt1) (cadr pnt2)) 2) 2.5)))
- ;;Determine the value of Sin * Cos (negative will be between 90° to 180° or above 270° and down will
- ;;be to the right. For all other angles, down will be to the left)
- (setq sinvscos (* (- (car pnt2) (car pnt1)) (- (cadr pnt2) (cadr pnt1))))
- ;;If the value of the sin and cos lengths is negative create leader arrow pointing left
- (if (< 0 sinvscos)
- (progn
- ;; First set XY values for Points
- (setq hp1 (- (car midapt) (abs (* (cos ang1) 5))))
- (setq vp1 (- (cadr midapt) (abs (* (sin ang1) 5))))
- (setq lpt1 (strcat (rtos hp1) "," (rtos vp1)))
- (setq hp2 (+ (car midapt) (abs (* (cos ang1) 5))))
- (setq vp2 (+ (cadr midapt) (abs (* (sin ang1) 5))))
- (setq lpt2 (strcat (rtos hp2) "," (rtos vp2)))
- ;;Draw Arrow
- (command "leader" lpt1 lpt2 "a" "" "n")
- ) ;end progn
- ) ;end if
- ;;If the value of the sin and cos lengths is positive create leader arrow pointing right
- (if (> 0 sinvscos)
- (progn
- ;; First set XY values for Points
- (setq hp1 (+ (car midapt) (abs (* (cos ang1) 5))))
- (setq vp1 (- (cadr midapt) (abs (* (sin ang1) 5))))
- (setq lpt1 (strcat (rtos hp1) "," (rtos vp1)))
- (setq hp2 (- (car midapt) (abs (* (cos ang1) 5))))
- (setq vp2 (+ (cadr midapt) (abs (* (sin ang1) 5))))
- (setq lpt2 (strcat (rtos hp2) "," (rtos vp2)))
- ;;Draw Arrow
- (command "leader" lpt1 lpt2 "a" "" "n")
- ) ;end progn
- ) ;end if
- (setvar "osmode" osmd)
- (princ)
- ) ; end defun
- (defun rtd (a)
- (/ (* a 180.0) pi)
- ) ; end defun
| 
置顶卡
