• Industries
  • Products
  • Buy
  • Services & Support
  • Communities
  • Visual LISP, AutoLISP and General Customization

    Reply
    Contributor
    Posts: 13
    Registered: ‎04-15-2008

    Spot Level

    298 Views, 6 Replies
    06-07-2012 06:00 AM

    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

    Please use plain text.
    Valued Mentor
    _Tharwat
    Posts: 459
    Registered: ‎07-02-2010

    Re: Spot Level

    06-07-2012 06:25 AM in reply to: jon.orchard

    This ... ?

     

    EDIT: code deleted

    Please use plain text.
    Contributor
    Posts: 13
    Registered: ‎04-15-2008

    Re: Spot Level

    06-07-2012 06:36 AM in reply to: _Tharwat

    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

     

    Please use plain text.
    Valued Contributor
    Posts: 61
    Registered: ‎03-21-2009

    Re: Spot Level

    06-07-2012 07:41 AM in reply to: jon.orchard

    works fine if you use "nea" snap for the point. However the "point" X is not present for me.

    HTH

    Please use plain text.
    Valued Mentor
    Posts: 267
    Registered: ‎10-15-2008

    Re: Spot Level

    06-09-2012 06:53 AM in reply to: jon.orchard

    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)
    )

     

    Please use plain text.
    Valued Contributor
    Posts: 61
    Registered: ‎03-21-2009

    Re: Spot Level

    06-09-2012 07:18 AM in reply to: CADaStroumph

    Great ! ! !  more than we could ever have asked for ! !

    Please use plain text.
    Contributor
    Posts: 13
    Registered: ‎04-15-2008

    Re: Spot Level

    06-11-2012 01:48 AM in reply to: jon.orchard

    thank you

    Please use plain text.