I use to have a great lisp file that would draw a spot level (cross and level similar to the attached) once you picked a point on a 3D polyline. I think it was via a dcl window for the text height.
I can't for the life of me remember the name, has anyone come across such a routine?
thanks Jon
Thanks, but this didn't work. It just gives a level of 0.000 on a 3d poly of 1-3 units high.
the steps on the old lisp were . . .
1. Define drawing scale (setting the cross size and text height)
2. Pick a point along a 3d poly (or elevated poly) - not just the entire line
3. Cross and text is inserted at that point, showing the height of that exact point
thanks for having a look though
And with a field?
Perhaps this:
(vl-load-com) (defun draw_pt (pt / rap dir) (setq rap (/ (getvar "VIEWSIZE") 50) dir (getvar "VIEWDIR") ) (foreach n '((0.5 0.5 0.0) (-0.5 0.5 0.0) (-0.5 -0.5 0.0) (0.5 -0.5 0.0)) (grdraw pt (mapcar '+ (mapcar '(lambda (x) (* x rap)) (trans n 0 1 T)) pt) -1) ) ) (defun c:IdZ_Field ( / js dxf_obj PathObj tmp tmp_wcs StartPoint htx rtx rtx0 AcDoc Space ncol nw_style obj nw_obj) (princ "\nSelect curve object.") (while (null (setq js (ssget "_+.:e:s" (list '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<AND") '(-4 . "<NOT") '(0 . "MLINE") '(-4 . "NOT>") '(-4 . "<NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") '(-4 . "AND>") ) ) ) ) (princ "\nIsn't an available object for this fonction!") ) (setq dxf_obj (entget (ssname js 0)) PathObj (vlax-ename->vla-object (ssname js 0))) (princ "\nGive startpoint of text") (while (= 5 (car (setq tmp (grread t 5 1)))) (cond ((eq 5 (car tmp)) (setq tmp_wcs (list (car (trans (cadr tmp) 1 0)) (cadr (trans (cadr tmp) 1 0))) StartPoint (vlax-curve-getClosestPointTo PathObj tmp_wcs) ) (redraw) (draw_pt (trans StartPoint 0 1)) (grdraw (trans StartPoint 0 1) (cadr tmp) -1) ) ) ) (cond ((eq 3 (car tmp)) (initget 6) (setq htx (getdist (cadr tmp) (strcat "\nSpecify the height of the field <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (cadr tmp) "\nSpecify the orientation of the field <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx) AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ncol '(174 2) ) (foreach n '("Id-Field Z" "Id-Point") (cond ((null (tblsearch "LAYER" n)) (vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol)) ) ) (setq ncol (cdr ncol)) ) (cond ((null (tblsearch "STYLE" "Romand-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (setvar "PDMODE" 2) (vlax-put (vla-AddPoint Space (vlax-3d-point startpoint)) 'layer "Id-Point") (setq obj (entlast) nw_obj (vla-addMtext Space (vlax-3d-point (trans (cadr tmp) 1 0)) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).Coordinates \\f \"%lu2%pt4%pr3%ps[Z=,]\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 7 (getvar "TEXTSIZE") 5 (trans (cadr tmp) 1 0) "Romand-Field" "Id-Field Z" rtx) ) ) (T (redraw)) ) (prin1) )
Can't find what you're looking for? Ask the community or share your knowledge.