- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
Could someone help me with the following Lisp routine please?
I use it to extract levels from point clouds in AutoCAD.
I was wondering if there is a way for the text to have the correct z value (client's requirement)
At the moment, the cross has the correct z value but the text has a z value of 0.
;------------------------------------------------------------------
; PICKLEV.lsp
;
; Desc:
; Macro to insert an cross & level and automatically add level value,
; from z value of 3d entity selected.
;
; by B.Frost 07/11/02 ver1.0
;------------------------------------------------------------------
; NOTE:
;
;------------------------------------------------------------------
(prompt "\nLoading PICKLEV Please wait...")
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a)))
)
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
(defun err (msg)
(moder) ; restore system varaibles.
(if (/= msg "Function cancelled")
(alert (strcat "\nError: " msg))
)
(setq *error* olderr) ;Restore old *error* handler
(princ)
)
;************************************************************************
; main program
;-------------
(defun C:bfAutoSP ()
(setq olderr *error*
*error* err)
(modes '("cmdecho" "Highlight" "Dimzin" "Osmode"))
(setvar "CMDECHO" 0)
(setvar "HIGHLIGHT" 0)
(setvar "DIMZIN" 1)
; Print copyright notice to screen
(princ "PickLev v1.0 ©2002 B.Frost")
(while T
; Start undo group
(command "UNDO" "G")
(setq lpos (getpoint "\nPick Level position: "))
(if (= nil lpos) (exit))
; Test if valid Level value picked, i.e. > 0.000
; **** COULD have option to prompt for text *****
;(print (caddr lpos))
(if (> (caddr lpos) 0.0)
(progn
(setq oldsnap (getvar "OSMODE")) ; save old snap mode
(setvar "OSMODE" 0)
(if (= nil lori)
(setq defori 0.0)
(setq defori lori)
)
(setq lori (getangle lpos (strcat "\nPick orientation <" (rtos (* defori (/ 180 pi)) 2 2) ">: ")))
(if (= nil lori) (setq lori defori) )
; is current text style variable height?
(setq sty (tblsearch "STYLE" (getvar "TEXTSTYLE")))
(setq txtht (cdr (assoc 40 sty)))
(setq vartxt (= (rtos txtht) (rtos 0))) ; is current text height zero
(if vartxt
(setq txtht (* 0.0015 (* 50 (getvar "LTSCALE")))) ; if so set a sensible text height
)
; Compute text position
(setq txtpos (Polar lpos lori (/ txtht 2)))
(setq txtori (* lori (/ 180 Pi) )) ; convert orientation from rads to degs
; get level value i.e. Z coord of selected point
(setq levtxt (rtos (caddr lpos) 2 2) )
;(print levtxt)
;(setq lpos (list (car lpos) (cadr lpos) 0)) ; take out z value from lpos
; Add Level Symbol
(command "_INSERT" "Cross" lpos txtht "" txtori)
; Add level text.
(command "_TEXT" "ML" txtpos)
(if vartxt (command txtht))
(command txtori levtxt)
(princ "\nMove text (ESC to keep position)")
(command "_Move" "L" "" txtpos pause)
;; (setq mvpt (getpoint "\nMove text:"))
;; (if (= nil mvpt) (setq mvpt txtpos))
;; (command mvpt)
(setq d1 (distance txtpos (cdr (assoc 10 (entget (entlast))))))
(setq d2 (distance '(0 0 0) txtpos))
(print d1)
(print d2)
(if (eq d1 d2)
(print"OOPS!")(print "OK")
)
(setvar "OSMODE" oldsnap)
) ; end progn
(print "Invalid point selection!")
) ; end if
; End undo group
(command "UNDO" "E")
) ; end while
(moder)
(setq *error* olderr)
(princ)
) ; end defun
Solved! Go to Solution.
