[编程交流] 截面标记的Lisp例程

(defun c:SECTMARK ()
(SETQ $PATH "C:/Documents and Settings/");CHANGE THIS TO THE PATH THAT YOU PASTE YOUR BLOCKS TO. CHEERS
(SE-erro)
(SE-quiet)
(SE-init)
(Get_mvs)
(pick1)
(ask1)
(setq #loc #org)  ;  ### Bubble Point
(make-pts1)
(setvar "attdia" 0)
(command
  "layer" "m" "TAGS" ""
  "insert" (strcat $PATH "Sec-ball") #loc DMS DMS "0" #sectno #drawno
  "insert" (strcat $PATH "Sec-arr")  #loc (* -1 DMS) DMS (rtd #ang)
); Arrow
(setvar "attdia" 1)
(setq TAIL "Sec-endB")
(setq MIR nil)
(setq MIR (getstring "\nFlip? Y/N <N>: "))
(if (/= MIR "")(setq MIR (strcase (substr MIR 1 1))))
(if (= MIR "Y")
(progn
(command "mirror" (entlast) "" #loc #2nd "y")
(setq TAIL "Sec-endA")))
(COMMAND "-INSERT" (strcat $PATH TAIL) "_r" (rtd (+ (* pi (/ 180 180)) #ang)) "_s" DMS #LOC )
(COMMAND "UCS" "Z" (RTD #ANG))
(SETVAR "ORTHOMODE" 1)
(princ "\nSelect base point to move section tail from..")
(COMMAND "MOVE" (ENTLAST) "" pause PAUSE)
(COMMAND "UCS" "P")
(SE-normal)
(setq *error* olderror)
(princ)
)
(defun dtr (a)
  (* pi (/ a 180.0))
)
(defun rtd (a)
  (* 180.0 (/ a pi))
)
(defun SE-init ()
(setq #45  (dtr 45)
     #90  (dtr 90)
     #135 (dtr 135)
     #180 (dtr 180)
     #225 (dtr 225)
     #270 (dtr 270)
     #315 (dtr 315)
)
)
(defun pick1 ()
(setq #org nil #2nd nil #side nil)
(while (= #org nil)
  (setq #org (getpoint "\nSelect Center point of Section Bubble: "))
)
(while (= #2nd nil)
  (setq #2nd (getpoint #org "\nRotation of Section mark?: "))
  (if (= (getvar "orthomode") 0)
     (setq orno T)
     (setq orno nil)
  )
)
(setq #ang (angle #org #2nd))
(setq #dist (distance #org #2nd))
)
(DEFUN Get_mvs ()
(if (and (= (getvar "cvport") 1)(= (getvar "tilemode") 0)) ; if in Paperspace
  (setq dms 1)
  (if  (= (getvar "tilemode") 0) ; if in Modelspace inside viewport
     (progn
        (vscl)
        (setq dms mvs)
     );progn
     (Try_Dimscale)
  );if
);if
);defun
(defun ask1 ()
(if #sectno
  (progn
     (setq #prevno #sectno)
     (setq #sectno (getstring (strcat "\nSection Number <" #prevno ">: ")))
     (if (= #sectno "")(setq #sectno #prevno))
  )
  (progn
     (setq #sectno (getstring "\nSection Number <1>: "))
     (if (= #sectno "") (setq #sectno "1"))
)
)
(if #drawno
  (progn
     (setq #prevdrawno #drawno)
     (setq #drawno (getstring (strcat "\nDrawing Reference <" #prevdrawno ">: ")))
     (if (= #drawno "")(setq #drawno #prevdrawno))
  )
  (progn
     (setq #drawno (getstring "\nDrawing Reference <->: "))
     (if (= #drawno "") (setq #drawno "-"))
  )
)
)
(defun make-pts1 ()
(setq #bb1  (polar #loc  (+ #ang #180) (* DMS 17.0)));; Bubble Centre
(setq #tp2  (polar #loc (+ #ang #90)  (* DMS 15.0))) ;; Text Left
(setq #tp1  (polar #2nd (+ #ang #90)  (* DMS 15.0))) ;; Text right
(cond
( (= #90 #ang)(setq #tang 0) )
( (= #270 #ang)(setq #tang 0) )
( (and (< #90 #ang)(> #270 #ang) )(setq #tang (+ #180 #ang)) )
( t (setq #tang #ang) )
);cond
)
(defun SE-quiet ()
(setvar "cmdecho"   0)
(setq OLDOSMODE (getvar "osmode"))
(setvar "osmode" 0)
(COMMAND "UNDO" "GROUP")
(setq angb   (getvar "angbase")
     angd   (getvar "angdir")
     orthom (getvar "orthomode")
     blipm  (getvar "blipmode")
)
(setvar "plinewid"  0)
(setvar "blipmode"  0)
(setvar "angbase"   0)
(setvar "angdir"    0)
(if orno (setvar "orthomode" 0)
        (setvar "orthomode" 1)
)
(CURRENT_COLOR)
(setq #CLA (getvar "clayer"))
(setq #CLT (getvar "celtype"))
(command "color" "bylayer")
(command "linetype" "s" "bylayer" "")
(command "layer" "m" "TAGS" "")
)
;;; Reset Values
(defun SE-normal ()
(if blipm   (setvar "blipmode"  blipm))
(if angb    (setvar "angbase"   angb))
(if angd    (setvar "angdir"    angd))
(if orthom  (setvar "orthomode" orthom))
(command "layer" "s" #CLA "")
(command "color" #CCN)
(command "linetype"  "s" #CLT "")
(COMMAND "UNDO" "END")
(setvar "cmdecho"   1)
(setvar "osmode" oldosmode)
)
(defun SE-erro () (setq olderr *error* *error* SEerra))
(defun SEerra (s)                            ; If an error (such as CTRL-C) occurs
                                          ; while this command is active...
  (if (/= s "Function cancelled")
     (princ (strcat "\nError: " s))
  )
  (if blipm   (setvar "blipmode"  blipm))
  (if angb    (setvar "angbase"   angb))
  (if angd    (setvar "angdir"    angd))
  (if orthom  (setvar "orthomode" orthom))
  (if #CLA    (command "layer" "s" #CLA ""))
  (if #CCN    (command "color" #CCN))
  (if #CLT    (command "linetype" "s" #CLT ""))
  (COMMAND "UNDO" "END")
  (setvar "cmdecho" 1)
  (setvar "osmode" oldosmode)
  (setq *error* olderr)                   ; restore old *error* handler
  (princ)
)
(defun CURRENT_COLOR ()
  (setq #CCN (getvar "cecolor"))
  (if (or (= #CCN "BYBLOCK")(= #CCN "BYLAYER"))
     (setq #cn #CCN)
     (progn
        (setq #cr (atoi #CCN))
        (if (and (> #cr 0) (< #cr )
           (progn
              (setq #CLIST (list "RED" "YELLOW" "GREEN" "CYAN" "BLUE" "MAGENTA" "WHITE"))
              (setq #cn (nth (- #cr 1) #CLIST))
           )
           (setq #cn (rtos #cr 2 0))
        )
     )
  )
)
(defun Try_Dimscale ()
(if (or (= (getvar "Dimscale") 0)(= (getvar "Dimscale") 1))
  (progn
     (initget 1)
     (setq dms (getint "\nEnter SCALE: "))
  )
  (setq dms (getvar "Dimscale"))
);if
);defun

Push the # button when posting - then paste your code between the two sets of brackets to do this.

Command:  INSERT-SECTMARK-BLOCK
Enter SCALE: 1
Select Center point of Section Bubble:
Rotation of Section mark?:
Section Number <1>: 1
Drawing Reference <2>: 2
"PersonalCADSUPPORTSec-ball.dwg": Can't find file in search path:
 C:\Documents and Settings\matthew.russell\My Documents\ (current directory)
 D:\Personal\CAD\Support\
 D:\Personal\CAD\MENU\
 D:\Personal\CAD\MENU\ICONS\
 C:\sp2000\
 X:\Acad\Support\Brisbane\Linetypes\
 X:\Acad\Support\Brisbane\Fonts\
 C:\Documents and Settings\matthew.russell\Application Data\Autodesk\AutoCAD 
2009\R17.2\enu\support\
 C:\Program Files\AutoCAD 2009\support\
 C:\Program Files\AutoCAD 2009\fonts\
 C:\Program Files\AutoCAD 2009\help\
 C:\Program Files\AutoCAD 2009\express\
 C:\Program Files\AutoCAD 2009\drv\
 C:\Program Files\AutoCAD 2009\
*Invalid*

 (SETQ $PATH "D:\Personal\CAD") 

  (SETQ $PATH "D:/Personal/CAD/") 

(defun Try_Dimscale ()
(if (or (= (getvar "Dimscale") 0)(= (getvar "Dimscale") 1))
  (progn
     (initget 1)
     (setq dms (getint "\nEnter SCALE: "))
  )
  (setq dms (getvar "Dimscale"))
);if
);defun

(defun Try_Dimscale ()
(setvar "DIMSCALE" (/ 1.0 (getvar "CANNOSCALEVALUE"))))
);defun

(SETQ $PATH "D:\Personal\CAD\Support")

(SETQ $PATH "D:/Personal/CAD/Support/")