Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 
Reply
Message 1 of 7
jon.orchard
1249 Views, 6 Replies

Spot Level

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

6 REPLIES 6
Message 2 of 7
_Tharwat
in reply to: jon.orchard

This ... ?

 

EDIT: code deleted

Message 3 of 7
jon.orchard
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

 

Message 4 of 7
stevesfr
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

Message 5 of 7

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

 

Message 6 of 7
stevesfr
in reply to: CADaSchtroumpf

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

Message 7 of 7
jon.orchard
in reply to: jon.orchard

thank you

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost