[编程交流] 帮助距离和方位lisp

;;;---------------------------------------------
;;; Rotina para desenhar uma linha com o ângulo
;;;---------------------------------------------
;;; Autolisp Rogério 09/12/04
(defun C:AZI ()
(setvar "cmdecho" 0)
;(setq PT1 (getpoint "Pick o ponto de início: "))
(setq DISTANCIA (getstring "\nDistância: "))
(setq CPTO (STRCAT "@" DISTANCIA "<"))
(setq GRAUS (getstring "\nÂngulo: "))
(setq MINUTOS (getstring "\nMinutos: "))
(setq SEGUNDOS (getstring "\nSegundos: "))
(setq ANG (STRCAT GRAUS "d" MINUTOS "'" SEGUNDOS """))
(princ "\nAzimute: ")
(PRINC CPTO)
(PRINC ANG)
(setq LINHA (STRCAT CPTO ANG))
(prompt "\nPick o ponto de início:")
;;(command "Poliline" pause CPTO ANG "")
(command "PLINE" pause LINHA "")
(command "units" 2 2 2 4 270 N "insunits" 0);;Decimal=2/ N°Casas=2/ Sistema Angulo=2/ Fração Angulo=4/ Direção Angulo=0/ Relógio=N
(setvar "cmdecho" 0)
(PRINC)
)
(Princ "\nDigite AZ para iniciar.")
(Princ)
;EXPLICAÇÃO: by Marcio
;================
;Command: -UNITS
;================
; 1. Scientific 1.55E+01
; 2. Decimal 15.50
; 3. Engineering 1'-3.50"
; 4. Architectural 1'-3 1/2"
; 5. Fractional 15 1/2
;With the exception of Engineering and Architectural formats,
;these formats can be used with any basic unit of measurement.
;For example, Decimal mode is perfect for metric units as well
;as decimal English units.
;Enter choice, 1 to 5 <2>:
;--------------------------------------------------------------
;Enter number of digits to right of decimal point (0 to Cool <2>:
;--------------------------------------------------------------
;Systems of angle measure: (Examples)
; 1. Decimal degrees 45.0000
; 2. Degrees/minutes/seconds 45d0'0"
; 3. Grads 50.0000g
; 4. Radians 0.7854r
; 5. Surveyor's units N 45d0'0" E
;Enter choice, 1 to 5 <2>:
;-------------------------------------------------------------- --------
;Enter number of fractional places for display of angles (0 to Cool <4>:
;-------------------------------------------------------------- --------
;Direction for angle 0d0'0":
; East 3 o'clock = 0d0'0"
; North 12 o'clock = 90d0'0"
; West 9 o'clock = 180d0'0"
; South 6 o'clock = 270d0'0"
;Enter direction for angle 0d0'0" <0d0'0">:
;-------------------------------------------
;Measure angles clockwise? [Yes/No] <N>
;-------------------------------------------
;================ ==
;Command: INSUNITS
;==================
;Enter new value for INSUNITS <0>:
;0 Unspecified (No units) = unitless
;1 Inches 

(SETQ ANGBASEE (GETVAR "ANGBASE"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ LUNITSS (GETVAR "LUNITS"))
(SETQ LUPRECC (GETVAR "LUPREC"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(SETQ AUPRECC (GETVAR "AUPREC"))
(SETVAR "LUNITS" 2)
(SETVAR "ANGBASE" (/ pi 2.0))
(SETVAR "ANGDIR" 1)
(SETVAR "LUPREC" 6)
(SETVAR "AUNITS" 0)
(SETVAR "AUPREC" 3)
;
(defun bear (P1)
  (setq ang_ans ""    
     ans_deg ""
     ans_min ""
     char_found ""
     ans_secs "")
 (setq ang_ans (getstring "\nEnter bearing angle in Deg.MMSS :"))
 (setq ans_len (strlen ang_ans))
 (setq x 0)
 (while (/= char_found ".")
   (setq x (+ x 1))
   (setq ans_deg (strcat ans_deg char_found))
   (setq char_found (substr ang_ans x 1))
   (if (= x 9)(setq char_found "."))
  )
  (setq x (+ x 1))
  (setq ans_min (substr ang_ans x 2))
  (setq x (+ x 2))
  (setq ans_secs (substr ang_ans x 2))
      
   (if (= ans_min "")(setq ans_min "0"))
   (if (= ans_secs "")(setq ans_secs "0"))
   (setq ang (dtr (+ (atof ans_deg)(/ (atof ans_min) 60.0)(/ (atof ans_secs) 3600.0))))    
   (setq dist (* (getdist P1 "\nLength of boundary ? (m) :") mm_vs_m))
   (setq p2 (polar p1 ang dist))
   (setq bear_call 1)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
Autolisp - WCB (whole circle bearing and distance) by Hew Choon Ming at [email="ocean_hew@hotmail.com"]ocean_hew@hotmail.com[/email]; 
2009
;; Draw Setting Out of Lines with Bearing and Distance.
;; Remove 
comments on code if you want circles at each end points, directional bearings 
and distances is labelled at midpt of lines
;;
;; Enter appropriate Text 
height for labelling Azimuths and distances
;; Select or pick points for AZ 
and distances. Labelling is directional and can be clockwise or 
anticlockwise
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (princ "Type: WCB to run.")(terpri)
 (princ "Setout WCB and 
Distance Between Points")
 (princ)
(defun C:WCB (/ pt1 pt2 middle DLENGTH aangle APA)
  (setq 
oldsnap (getvar "Osmode")
  oldangdir (getvar 
"angdir")
  oldangbase (getvar "angbase")
)
   (setvar "cmdecho" 0)
   (setvar 
"angdir" 1) ; clockwise
   (setvar "angbase" (/ pi 2)) ; zero 
direction north ; for setting out using bearing, azimuth starts from 
north
;;Get text height for value label
   (setq apa 
(getreal "\n Text Height for value label: "))
   (if apa nil 
(setq apa 3.0))
 (While 
      (Setq 
Pt1 (getpoint "\nPick the Location of Start 
Pt"))(terpri)
      (setq oldsnap1 (getvar 
"Osmode"))
      (setq pt2 (getpoint "\nPick 
Location of End Pt? " pt1))
      (command 
"line" pt1 pt2 "") 
;;(Setq Pt2 (getpoint "Pick the Location of End Pt"))(terpri)
      (Setq middle (List (/ (+ (car pt1) (car 
pt2)) 2.0) (/ (+ (cadr pt1) (cadr pt2)) 
2.0)))
      (Setq Dlength (distance pt1 pt2)) 
      (setq aangle (angle pt1 
pt2))
      (command "Line" Pt1 PT2 "")
;; Remove semi-colon if you want circles at each end points
;;(command 
"circle" PT1 (* Apa 0.5))
;;(command "circle" PT2 (* Apa 0.5))
     (setvar "Osmode" 0) ; no 
snaps
        (If (Or(<= aangle 
(/ pi 2))(>= aangle (* pi 
1.5)))
(progn
(command "text" "j" "Bc" middle apa pt2 (RTOS Dlength 2 
3))
(Setq middleoff (polar middle (+ (angle middle pt2) -1.5708) (* 0.4 
apa)))
(Setq pt2Off (polar pt2 (+ (angle middle pt2) -1.5708)(* 0.4 
apa)))
(command "text" "j" "tc" middleoff apa pt2off (strcat (angtos aangle 1 5) 
">>"))
) ;End progn
         ) ;End 
if
       (if  (And(< aangle (* pi 
1.5))(> aangle (/ pi 
2)))
(progn
(command "text" "j" "Bc" middle apa pt1 (RTOS Dlength 2 
3))
           (Setq 
middleoff (polar middle (+ (angle middle pt1) -1.5708) (* 0.4 
apa)))
(Setq pt1Off (polar pt1 (+ (angle middle pt1) -1.5708) (* 0.4 
apa)))
(command "text" "j" "tc" middleoff apa pt1off (strcat "<<" (angtos aangle 
1 5)))
           ) 
;End progn
        ) ;End 
if
     (setvar "Osmode" oldsnap1)
) ;End while
 (setvar "Osmode" oldsnap)
 (setvar "angdir" 
oldangdir)
 (setvar "angbase" oldangbase)
 (princ)
)

; error: no function definition: WHOLE
_$