[编程交流] Lisp编码帮助

(defun C:scable2 (/)
 (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:dcable2 ()
 (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()
 (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))
   (command "insert" "NEW-ARROW" (polar pt3 (angle pt3 pt4) 12)
       (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
   (txt2)
);end defun ins4
(defun txt1 ()
 (Setq old (Getvar "clayer"))
 (if (tblsearch "layer" "FPTEXT")(Setvar "clayer" "FPTEXT") 
(command "layer" "M" "FPTEXT" "C" "green" "" "")
 );end if
  (if (/= (setq dis1 (/ (+ 18.51 (distance pt3 pt4)) 12)) (fix dis1))
      (setq dis1 (+ (fix dis1) 1))
   );end if
  (setq dis2 (strcat "S-" (rtos dis1 2 0)))
(command "text" "m" pt2 (* 0.125 (getvar "ltscale")) (rtd ang1) dis2)
(command "setvar" "clayer" old )
);end defun txt1
                             
(defun txt2 ()
 (Setq old (Getvar "clayer"))
 (if (tblsearch "layer" "FPTEXT")(Setvar "clayer" "FPTEXT") 
(command "layer" "M" "FPTEXT" "C" "green" "" "")
 );end if
  (if (/= (setq dis1 (/ (+ 18.51 (distance pt3 pt4)) 12)) (fix dis1))
      (setq dis1 (+ (fix dis1) 1))
   );end if
  (setq dis2 (strcat "S/B-" (rtos dis1 2 0)))
  
     (command "text" "m" pt2 (* 0.125 (getvar "ltscale")) (rtd ang1) dis2)
(command "setvar" "clayer" old )
);end defun txt2