135 lines
3.4 KiB
Common Lisp
135 lines
3.4 KiB
Common Lisp
(Defun C:URSP-BEM ()
|
|
(Setvar "Cmdecho" 0)
|
|
(Setq DS (Getvar "Dimscale"))
|
|
(Setq DL (Getvar "Dimlfac"))
|
|
(Setq EX (Getvar "Dimexo"))
|
|
(Setq TI (Getvar "Dimtih"))
|
|
(Setq C '(= 0 (Cdr (Assoc 40 (Tblsearch "Style" (Getvar "Textstyle"))))))
|
|
(If
|
|
(= nil BASE)
|
|
(Setq BASE (Getpoint "\nUrsprungspunkt fuer Bemassungen bestimmen: "))
|
|
)
|
|
(If
|
|
(= 0 (Setq TX (Cdr (Assoc 40 (Tblsearch "Style" (Getvar "Textstyle"))))))
|
|
(Progn
|
|
(Setq TX (Getvar "Dimtxt"))
|
|
(Setq B (* (/ TX 2.0) DS))
|
|
)
|
|
(Progn
|
|
(Setq B (/ TX 2.0))
|
|
)
|
|
)
|
|
(Command "OFANG" "End,Sch,Zen")
|
|
(Setq P1 (Getpoint "\nErster Punkt: "))
|
|
(Command "OFANG" "Kei")
|
|
(Setq P2 (Getpoint P1"\nZweiter Punkt: "))
|
|
(If
|
|
(> (Abs (- (Car P1) (Car P2))) (Abs (- (Cadr P1) (Cadr P2))))
|
|
(Progn
|
|
(Setq P2 (List (Car P2) (Cadr P1)))
|
|
(Basehorz)
|
|
)
|
|
(Progn
|
|
(Setq P2 (List (Car P1) (Cadr P2)))
|
|
(Basevert)
|
|
)
|
|
)
|
|
(Command "LINIE" P1 P2 "")
|
|
(Princ)
|
|
)
|
|
|
|
(Defun Basehorz ()
|
|
(Princ "\nBemassungstext <")
|
|
(Princ (Setq D (Rtos (* DL (Abs (- (Cadr P1) (Cadr BASE))))
|
|
(Getvar "Lunits") (Getvar "Luprec"))))
|
|
(Setq A (Getstring t ">: "))
|
|
(If
|
|
(= "" A)
|
|
(Setq A D)
|
|
)
|
|
(If
|
|
(<= (Car P2) (Car P1))
|
|
(Progn
|
|
(Setq P1 (List (- (Car P1) (* EX DS)) (Cadr P1)))
|
|
(Setq P3 (List (- (Car P2) B) (- (Cadr P2) B)))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" "R" P3 (* TX DS) "0" A)
|
|
(Command "Text" "R" P3 "0" A)
|
|
)
|
|
)
|
|
(Progn
|
|
(Setq P1 (List (+ (Car P1) (* EX DS)) (Cadr P1)))
|
|
(Setq P3 (List (+ (Car P2) B) (- (Cadr P2) B)))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" P3 (* TX DS) "0" A)
|
|
(Command "Text" P3 "0" A)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(Defun Basevert ()
|
|
(Princ "\nBemassungstext <")
|
|
(Princ (Setq D (Rtos (* DL (Abs (- (Car P1) (Car BASE))))
|
|
(Getvar "Lunits") (Getvar "Luprec"))))
|
|
(Setq A (Getstring t ">: "))
|
|
(If
|
|
(= "" A)
|
|
(Setq A D)
|
|
)
|
|
(If
|
|
(<= (Cadr P2) (Cadr P1))
|
|
(Progn
|
|
(Setq P1 (List (Car P1) (- (Cadr P1) (* EX DS))))
|
|
(If
|
|
(= TI 1)
|
|
(Progn
|
|
(Setq P3 (List (Car P2) (- (Cadr P2) (* 3 B))))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" "Z" P3 (* TX DS) "0" A)
|
|
(Command "Text" "Z" P3 "0" A)
|
|
)
|
|
)
|
|
(Progn
|
|
(Setq P3 (List (+ (Car P2) B) (- (Cadr P2) B)))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" "R" P3 (* TX DS) "90" A)
|
|
(Command "Text" "R" P3 "90" A)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(Progn
|
|
(Setq P1 (List (Car P1) (+ (Cadr P1) (* EX DS))))
|
|
(If
|
|
(= TI 1)
|
|
(Progn
|
|
(Setq P3 (List (Car P2) (+ (Cadr P2) B)))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" "Z" P3 (* TX DS) "0" A)
|
|
(Command "Text" "Z" P3 "0" A)
|
|
)
|
|
)
|
|
(Progn
|
|
(Setq P3 (List (+ (Car P2) B) (+ (Cadr P2) B)))
|
|
(If
|
|
(Eval C)
|
|
(Command "Text" P3 (* TX DS) "90" A)
|
|
(Command "Text" P3 "90" A)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(Defun C:BEM-URSP ()
|
|
(Setq BASE (Getpoint "\nUrsprungspunkt fuer Bemassungen bestimmen: "))
|
|
)
|
|
|