PDA

View Full Version : LISP Routine that worked in LDT hasn't in 3D


BoarsNest01
2009-03-17, 09:30 PM
I have a surveying LISP routine that worked wonderfully in Land Desktop that does not work in Civil3D. Every time I use the command I get the following error: "no function definition: F:BEAR". If anyone can help fix this, I would be forever grateful!!

(defun c:bdd (/ oldcmd scle oldbm nrtate ptsty txtsz offdst b1 b tspt ptm pts pte pt1 pt2 dectdeg tdeg tmin tsec cksec deg_sp sec_sp min_sp tdst flip angb angc angb1 dist brng3 brngl ns ew brng blngth dlngth bdlngth ptb ptd pt3 pt4 pt5 rmdst clr pco ptt just ent)
;___________________________________________________________
(defun dtr (a)
(* pi (/ a 180.0))
)
(defun *error* (ms)
(princ ms)
(princ)
)
(setq oldcmd (getvar "CMDECHO"))
(setq scle (getvar "DIMSCALE"))
(setq oldbm (getvar "BLIPMODE"))
(setq ptsty (tblsearch "style" (getvar "textstyle")))
(setq txtsz (cdr (assoc 40 ptsty)))
(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 0)
(setvar "BLIPMODE" 0)
;___________________________________________________________
(defun get_bdd ()
(if (< (distance tspt pts) (distance tspt pte))
(progn
(setq pt1 pts)
(setq pt2 pte)
)
(progn
(setq pt1 pte)
(setq pt2 pts)
)
)
(setq angc (angle pt1 pt2))
(setq dist (distance pt1 pt2))
(if (> angc (dtr 92))
(progn
(if (< angc (dtr 272))
(setq angc (+ angc (dtr 180)))
)
)
)
(setq brng (f:bear pt1 pt2 "%%d"))
(setq brngl (strlen brng))

(setq blngth (- (strlen brng) 3.5))
(setq dlngth (strlen (rtos dist 2 2)))

(if (= brng "S00%%d00'00\"E")
(progn
(setq brng "SOUTH")
(setq blngth (strlen brng))
)
)
(if (= brng "N00%%d00'00\"E")
(progn
(setq brng "NORTH")
(setq blngth (strlen brng))
)
)
(if (= brng "N00%%d00'00\"W")
(progn
(setq brng "NORTH")
(setq blngth (strlen brng))
)
)
(if (= brng "S00%%d00'00\"W")
(progn
(setq brng "SOUTH")
(setq blngth (strlen brng))
)
)
(if (= brng "S90%%d00'00\"E")
(progn
(setq brng "EAST")
(setq blngth (strlen brng))
)
)
(if (= brng "N90%%d00'00\"E")
(progn
(setq brng "EAST")
(setq blngth (strlen brng))
)
)
(if (= brng "N90%%d00'00\"W")
(progn
(setq brng "WEST")
(setq blngth (strlen brng))
)
)
(if (= brng "S90%%d00'00\"W")
(progn
(setq brng "WEST")
(setq blngth (strlen brng))
)
)
(setq bdlngth (+ blngth dlngth))
);end get_bdd
;___________________________________________________________
(defun sprd_bdd ()
(setq pt3 (getpoint "\nPick point on side to place dimension. "))
(setq ptb (polar pt3 (+ (angle pt1 pt2) (dtr 90)) 20))
(setq pte (inters pt3 ptb pt1 pt2 nil))
(setq pte (polar ptm (angle pte pt3)(+ offdst (* txtsz 0.5))))
(setq rmdst (/ (- dist (* bdlngth txtsz)) 3))
(setq ptb (polar pte (+ angc (dtr 180)) (- (* dist 0.5) (+ rmdst (* (* blngth 0.5) txtsz)))))
(setq ptd (polar pte angc (- (* dist 0.5) (+ rmdst (* (* dlngth 0.5) txtsz)))))
(command "text" "mc" ptd (angtos angc) (rtos dist 2 2))
(command "text" "mc" ptb (angtos angc) brng)
)
;___________________________________________________________
(defun stck_bdd ()
(setq pt3 (getpoint "\nPick point on side to place dimension. "))
(setq ptb (polar pt3 (+ (angle pt1 pt2) (dtr 90)) 20))
(setq ptb (inters pt3 ptb pt1 pt2 nil))
(setq ptb (polar ptm (angle ptb pt3) (+ offdst (* txtsz 0.5))))
(setq ptd (polar ptb (angle ptm ptb) (* txtsz 1.75)))
(command "text" "mc" ptd (angtos angc) (rtos dist 2 2))
(command "text" "mc" ptb (angtos angc) brng)
)
;___________________________________________________________
(defun offs_bdd ()
(setq pt3 (getpoint ptm "\nThe dimension will not fit on this line, pick insertion point. "))
(setq pt4 (polar pt1 (angle pt1 pt3)(/ (distance pt1 pt3) 1.75)))
(setq pt5 (polar pt2 (angle pt2 pt3)(/ (distance pt2 pt3) 1.75)))
(setq pt5 (polar pt5 (angle pt5 pt4)(/ (distance pt5 pt4) 5)))
(setq pt4 (polar pt4 (angle pt4 pt5)(/ (distance pt4 pt5) 2.5)))
(command "arc" pt1 pt4 pt3)
(setq clr (entget (entlast)))
(setq pco (cdr (assoc 6 clr)))
(if (= pco continuous)
(command "chprop" "L" "" "lt" "hidden2" "")
)
(command "arc" pt2 pt5 pt3)
(setq clr (entget (entlast)))
(setq pco (cdr (assoc 6 clr)))
(if (= pco continuous)
(command "chprop" "L" "" "lt" "hidden2" "")
)
(setq angc (angle ptm pt3))
(if (> angc (dtr 91))
(progn
(if (< angc (dtr 271))
(progn
(setq angc (+ angc (dtr 180)))
(setq flip "y")
)
)
)
)
(setq ptt (polar pt3 (angle ptm pt3) txtsz))
(setq ptd (polar ptt (+ angc (dtr 90)) (* txtsz 0.75)))
(setq ptb (polar ptt (- angc (dtr 90)) (* txtsz 0.75)))
(if (= flip "y")
(setq just "mr")
(setq just "ml")
)
(command "text" just ptd (angtos angc) (rtos dist 2 2))
(command "text" just ptb (angtos angc) brng)
(setq flip "n")
)
;___________________________________________________________
(setq offdst (getreal "\nOffset distance: "))
(setvar "osmode" 512)
(setq tspt (getpoint "\nSelect line: "))
(setvar "osmode" 0)
(while tspt
(setq b1 (ssget tspt))
(setq ent (ssname b1 0))
(setq b (entget ent))
(if (not (equal (cdr (assoc 0 b)) "LINE"))
(princ "\nThis routine only labels lines. Dummy!")
(progn
(setq pts (cdr (assoc 10 b)))
(setq pte (cdr (assoc 11 b)))
(setq ptm (polar pts (angle pts pte) (/ ( distance pts pte) 2)))
(get_bdd)
(if (< dist (* bdlngth txtsz))
(progn
(if (< dist (* blngth txtsz))
(offs_bdd)
(stck_bdd)
)
)
(sprd_bdd)
)
)
)
(setq tspt nil)
(setvar "osmode" 512)
(setq tspt (getpoint "\nSelect line: "))
(setvar "osmode" 0)
)
(setvar "cmdecho" oldcmd)
(setvar "BLIPMODE" oldbm)
(princ)
(princ)
)

rkmcswain
2009-03-17, 09:50 PM
The lisp code is expecting the function F:BEAR, but it is undefined.

This line specifically is calling it.


(setq brng (f:bear pt1 pt2 "%%d"))


If you can find this function, put it at the top of the file you are loading and try again.

P.S. Your code will be much more readable here in the forum if you will encase it with CODE tags like this:



(setvar "cmdecho" oldcmd)
(setvar "BLIPMODE" oldbm)
(princ)
(princ)




...so that it will look like this...


(setvar "cmdecho" oldcmd)
(setvar "BLIPMODE" oldbm)
(princ)
(princ)