Jump to content

lisp to put text with pline leangth above line

chelsea1307

By chelsea1307
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

chelsea1307 Mentor

chelsea1307

Posted
Posted

Im just learning lisp and having a major brain freeze and need this soon. Its probably really simple for someone who knows what there doing and If i had time i could probably figure it out. I just need it to get the leangth of a pline and insert text or mtext on or above the line. It doesnt have to look pretty cuz its just for calcs not going to be seen on plots. any help would be great

 

(if a mod sees this please move to lisp forum i posted in the wrong section)

Link to comment
Share on other sites
  • Replies 42
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    17

  • stevesfr

    9

  • chelsea1307

    4

  • ReMark

    3

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac Grand Master

Lee Mac

Posted
Posted

Give this a shot :D [Length to 2 dp.]

 

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:plLen [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] cEnt tStr tBox tHgt tWid gr sPt
                 cPt lAng bPt tPt pt1 pt2 pt3 pt4[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cEnt [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Object: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]member[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]0[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] cEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                  [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#ff00ff]"LWPOLYLINE"[/color][/b] [b][color=#ff00ff]"POLYLINE"[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tStr [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-length[/color][/b]
                        [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] cEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b]
         tBox [b][color=RED]([/color][/b][b][color=BLUE]textbox[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]1[/color][/b] tStr[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         tHgt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadadr[/color][/b] tBox[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadar[/color][/b] tBox[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         twid [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caadr[/color][/b] tBox[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caar[/color][/b] tBox[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nPosition Text..."[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] gr [b][color=RED]([/color][/b][b][color=BLUE]grread[/color][/b] [b][color=BLUE]t[/color][/b] [b][color=#009900]5[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]listp[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] sPt [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cPt [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getClosestPointto[/color][/b] cEnt sPt[b][color=RED])[/color][/b]
                 lAng [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] cPt sPt[b][color=RED])[/color][/b]
                 bpt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] cPt lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 tpt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bpt lAng tHgt[b][color=RED])[/color][/b]
                 mPt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bPt lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tHgt [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 pt1 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bpt [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 pt2 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bPt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 pt3 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] tpt [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 pt4 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] tPt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]grvecs[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=#009900]-3[/color][/b] pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]3[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=#009900]3[/color][/b] [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
            [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b]Make_Text mPt tStr lAng[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> Incorrect Selection <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] Make_Text  [b][color=RED]([/color][/b]pt val rot[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]entmake[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"TEXT"[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]8[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"CLAYER"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]62[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] pt[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]1[/color][/b] val[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]50[/color][/b] rot[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]7[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSTYLE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]71[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]72[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]73[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]11[/color][/b] pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

Link to comment
Share on other sites
VVA Rising Star

VVA

Posted
Posted

Other version. Insert field.

(defun c:plLen1 (/ cEnt tStr tBox tHgt tWid gr sPt
                 cPt lAng bPt tPt pt1 pt2 pt3 pt4)
 (vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LWPOLYLINE" "POLYLINE" "LINE")))
   (progn
     (setq tStr (strcat "%<\\AcObjProp Object(%<\\_ObjId "
               (vl-princ-to-string
                 (vla-get-objectid (vlax-ename->vla-object cEnt))
                 ) ;_ vl-princ-to-string
               ">%).Length \\f \"%lu2%pr2\">%"
               ) ;_ strcat
         tBox (textbox (list (cons 1 (rtos (vla-get-length
                        (vlax-ename->vla-object cEnt)) 2 2)) (cons 40 (getvar "TEXTSIZE"))))
         tHgt (- (cadadr tBox) (cadar tBox))
         twid (- (caadr tBox) (caar tBox)))
     (princ "\nPosition Text...")
     (while (eq 5 (car (setq gr (grread t 5 0))))
       (redraw)
       (if (listp (setq sPt (cadr gr)))
         (progn
           (setq cPt (vlax-curve-getClosestPointto cEnt sPt)
                 lAng (angle cPt sPt)
                 bpt (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
                 tpt (polar bpt lAng tHgt)
                 mPt (polar bPt lAng (/ tHgt 2.))
                 pt1 (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt2 (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
                 pt3 (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt4 (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
           (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
     (if (eq 3 (car gr))
       (progn
         (setq lAng (- lAng (/ pi 2.)))
         (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
            (setq lAng (- lAng pi)))
           ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
            (setq lAng (+ lAng pi))))
         (Make_Text mPt tStr lAng)
         (vl-cmdf "_updatefield" (entlast) ""))))
   (princ "\n<!> Incorrect Selection <!>"))
 (redraw)
 (princ))

(defun Make_Text  (pt val rot)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 62 2)
     (cons 10 pt)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 rot)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt))))

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
Give this a shot :D [Length to 2 dp.]

 

[b][color=red]([/color][/b][b][color=blue]defun[/color][/b] c:plLen [b][color=red]([/color][/b][b][color=blue]/[/color][/b] cEnt tStr tBox tHgt tWid gr sPt
                 cPt lAng bPt tPt pt1 pt2 pt3 pt4[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]vl-load-com[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]if[/color][/b] [b][color=red]([/color][/b][b][color=blue]and[/color][/b] [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] cEnt [b][color=red]([/color][/b][b][color=blue]car[/color][/b] [b][color=red]([/color][/b][b][color=blue]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Object: "[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
          [b][color=red]([/color][/b][b][color=blue]member[/color][/b] [b][color=red]([/color][/b][b][color=blue]cdr[/color][/b] [b][color=red]([/color][/b][b][color=blue]assoc[/color][/b] [b][color=#009900]0[/color][/b] [b][color=red]([/color][/b][b][color=blue]entget[/color][/b] cEnt[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                  [b][color=darkred]'[/color][/b][b][color=red]([/color][/b][b][color=#ff00ff]"LWPOLYLINE"[/color][/b] [b][color=#ff00ff]"POLYLINE"[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
   [b][color=red]([/color][/b][b][color=blue]progn[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] tStr [b][color=red]([/color][/b][b][color=blue]rtos[/color][/b] [b][color=red]([/color][/b][b][color=blue]vla-get-length[/color][/b]
                        [b][color=red]([/color][/b][b][color=blue]vlax-ename->vla-object[/color][/b] cEnt[b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=#009900]2[/color][/b] [b][color=#009900]2[/color][/b][b][color=red])[/color][/b]
         tBox [b][color=red]([/color][/b][b][color=blue]textbox[/color][/b] [b][color=red]([/color][/b][b][color=blue]list[/color][/b] [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]1[/color][/b] tStr[b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
         tHgt [b][color=red]([/color][/b][b][color=blue]-[/color][/b] [b][color=red]([/color][/b][b][color=blue]cadadr[/color][/b] tBox[b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]cadar[/color][/b] tBox[b][color=red])[/color][/b][b][color=red])[/color][/b]
         twid [b][color=red]([/color][/b][b][color=blue]-[/color][/b] [b][color=red]([/color][/b][b][color=blue]caadr[/color][/b] tBox[b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]caar[/color][/b] tBox[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]princ[/color][/b] [b][color=#ff00ff]"\nPosition Text..."[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]while[/color][/b] [b][color=red]([/color][/b][b][color=blue]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=red]([/color][/b][b][color=blue]car[/color][/b] [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] gr [b][color=red]([/color][/b][b][color=blue]grread[/color][/b] [b][color=blue]t[/color][/b] [b][color=#009900]5[/color][/b] [b][color=#009900]0[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
       [b][color=red]([/color][/b][b][color=blue]redraw[/color][/b][b][color=red])[/color][/b]
       [b][color=red]([/color][/b][b][color=blue]if[/color][/b] [b][color=red]([/color][/b][b][color=blue]listp[/color][/b] [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] sPt [b][color=red]([/color][/b][b][color=blue]cadr[/color][/b] gr[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
         [b][color=red]([/color][/b][b][color=blue]progn[/color][/b]
           [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] cPt [b][color=red]([/color][/b][b][color=blue]vlax-curve-getClosestPointto[/color][/b] cEnt sPt[b][color=red])[/color][/b]
                 lAng [b][color=red]([/color][/b][b][color=blue]angle[/color][/b] cPt sPt[b][color=red])[/color][/b]
                 bpt [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] cPt lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=red])[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                 tpt [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] bpt lAng tHgt[b][color=red])[/color][/b]
                 mPt [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] bPt lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] tHgt [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                 pt1 [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] bpt [b][color=red]([/color][/b][b][color=blue]+[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                 pt2 [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] bPt [b][color=red]([/color][/b][b][color=blue]-[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                 pt3 [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] tpt [b][color=red]([/color][/b][b][color=blue]+[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
                 pt4 [b][color=red]([/color][/b][b][color=blue]polar[/color][/b] tPt [b][color=red]([/color][/b][b][color=blue]-[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
           [b][color=red]([/color][/b][b][color=blue]grvecs[/color][/b] [b][color=red]([/color][/b][b][color=blue]list[/color][/b] [b][color=#009900]-3[/color][/b] pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]if[/color][/b] [b][color=red]([/color][/b][b][color=blue]eq[/color][/b] [b][color=#009900]3[/color][/b] [b][color=red]([/color][/b][b][color=blue]car[/color][/b] gr[b][color=red])[/color][/b][b][color=red])[/color][/b]
       [b][color=red]([/color][/b][b][color=blue]progn[/color][/b]
         [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]-[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
         [b][color=red]([/color][/b][b][color=blue]cond[/color][/b] [b][color=red]([/color][/b][b][color=red]([/color][/b][b][color=blue]and[/color][/b] [b][color=red]([/color][/b][b][color=blue]>[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=blue]pi[/color][/b] [b][color=#009900]2[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]<=[/color][/b] lAng [b][color=blue]pi[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
            [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]-[/color][/b] lAng [b][color=blue]pi[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
           [b][color=red]([/color][/b][b][color=red]([/color][/b][b][color=blue]and[/color][/b] [b][color=red]([/color][/b][b][color=blue]>[/color][/b] lAng [b][color=blue]pi[/color][/b][b][color=red])[/color][/b] [b][color=red]([/color][/b][b][color=blue]<=[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]/[/color][/b] [b][color=red]([/color][/b][b][color=blue]*[/color][/b] [b][color=#009900]3[/color][/b] [b][color=blue]pi[/color][/b][b][color=red])[/color][/b] [b][color=#009900]2[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
            [b][color=red]([/color][/b][b][color=blue]setq[/color][/b] lAng [b][color=red]([/color][/b][b][color=blue]+[/color][/b] lAng [b][color=blue]pi[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
         [b][color=red]([/color][/b]Make_Text mPt tStr lAng[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
   [b][color=red]([/color][/b][b][color=blue]princ[/color][/b] [b][color=#ff00ff]"\n<!> Incorrect Selection <!>"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]redraw[/color][/b][b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]princ[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]

[b][color=red]([/color][/b][b][color=blue]defun[/color][/b] Make_Text  [b][color=red]([/color][/b]pt val rot[b][color=red])[/color][/b]
 [b][color=red]([/color][/b][b][color=blue]entmake[/color][/b]
   [b][color=red]([/color][/b][b][color=blue]list[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"TEXT"[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]8[/color][/b] [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"CLAYER"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]62[/color][/b] [b][color=#009900]2[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]10[/color][/b] pt[b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]1[/color][/b] val[b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]50[/color][/b] rot[b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]7[/color][/b] [b][color=red]([/color][/b][b][color=blue]getvar[/color][/b] [b][color=#ff00ff]"TEXTSTYLE"[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]71[/color][/b] [b][color=#009900]0[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]72[/color][/b] [b][color=#009900]1[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]73[/color][/b] [b][color=#009900]2[/color][/b][b][color=red])[/color][/b]
     [b][color=red]([/color][/b][b][color=blue]cons[/color][/b] [b][color=#009900]11[/color][/b] pt[b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b][b][color=red])[/color][/b]

 

LM, neato !! but

This is part of what I have been trying to figure out for hours and hours. If I want to create a block with two attributes, lets say first attribute would be just text description of what the line represents, steel, plastic or whatever, and the second attribute would be the length of the line as calculated by the above program. How can I get the length of the line (by pick) into the attribute of the block I insert close to the appropriate line?

couple of hints? then later we'll discuss how to get (rake) the attributes into excel, which is no problem, except for totaling like material lengths before inserting into excel.

one thing at a time.... gone fishing !

thx

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
LM, neato !! but

This is part of what I have been trying to figure out for hours and hours. If I want to create a block with two attributes, lets say first attribute would be just text description of what the line represents, steel, plastic or whatever, and the second attribute would be the length of the line as calculated by the above program. How can I get the length of the line (by pick) into the attribute of the block I insert close to the appropriate line?

couple of hints? then later we'll discuss how to get (rake) the attributes into excel, which is no problem, except for totaling like material lengths before inserting into excel.

one thing at a time.... gone fishing !

thx

 

Hi Steve,

 

Thanks for your praise, it is much appreciated. :D

 

What is the name of your block that you want to use? Or would you like the LISP to make the block from scratch?

 

Lee

Link to comment
Share on other sites
chelsea1307 Mentor

chelsea1307

Posted
  • Author
Posted

That works great Lee Mac. One question, is there a way to get the out put in feet instead of inches. Right now Im just dividing by 12 before i enter it into the calc program but if it could do that itself it would be great

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
That works great Lee Mac. One question, is there a way to get the out put in feet instead of inches. Right now Im just dividing by 12 before i enter it into the calc program but if it could do that itself it would be great

 

Hmmm.. be careful - I set it to output in Metric - so your results may be in mm at the moment...

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

This will now depend on your settings of LUNITS, LUPREC etc - I have divided the length by 12 for you also.

 

(defun c:plLen  (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4)
 (vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LWPOLYLINE" "POLYLINE" "LINE")))
   (progn
     (setq tStr (rtos (/ (vla-get-length
                           (vlax-ename->vla-object cEnt)) 12.))
           tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
           tHgt (- (cadadr tBox) (cadar tBox))
           twid (- (caadr tBox) (caar tBox)))
     (princ "\nPosition Text...")
     (while (eq 5 (car (setq gr (grread t 5 0))))
       (redraw)
       (if (listp (setq sPt (cadr gr)))
         (progn
           (setq cPt  (vlax-curve-getClosestPointto cEnt sPt)
                 lAng (angle cPt sPt)
                 bpt  (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
                 tpt  (polar bpt lAng tHgt)
                 mPt  (polar bPt lAng (/ tHgt 2.))
                 pt1  (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt2  (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
                 pt3  (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt4  (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
           (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
     (if (eq 3 (car gr))
       (progn
         (setq lAng (- lAng (/ pi 2.)))
         (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                (setq lAng (- lAng pi)))
               ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                (setq lAng (+ lAng pi))))
         (Make_Text mPt tStr lAng))))
   (princ "\n<!> Incorrect Selection <!>"))
 (redraw)
 (princ))

(defun Make_Text  (pt val rot)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 62 2)
     (cons 10 pt)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 rot)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt))))

Link to comment
Share on other sites
chelsea1307 Mentor

chelsea1307

Posted
  • Author
Posted

I set lunits to 3 (engineering) and luprecto 0 but my leangth arent right. A pl a little over 15' is coming out as 1' any suggestions? I think its now outputting in feet and then dividing my feet by 12. Can you take out the divide by 12. I tried but the result didnt change. I might have changes the wrong part

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

I have used "rtos" with no arguments, hence it will rely on your settings for LUNITS, and LUPREC - then all I have done is divided this number by 12.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Without the division:

 

(defun c:plLen  (/ cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4)
 (vl-load-com)
 (if (and (setq cEnt (car (entsel "\nSelect Object: ")))
          (member (cdr (assoc 0 (entget cEnt)))
                  '("LWPOLYLINE" "POLYLINE" "LINE")))
   (progn
     (setq tStr (rtos (vla-get-length
                        (vlax-ename->vla-object cEnt)))
           tBox (textbox (list (cons 1 tStr) (cons 40 (getvar "TEXTSIZE"))))
           tHgt (- (cadadr tBox) (cadar tBox))
           twid (- (caadr tBox) (caar tBox)))
     (princ "\nPosition Text...")
     (while (eq 5 (car (setq gr (grread t 5 0))))
       (redraw)
       (if (listp (setq sPt (cadr gr)))
         (progn
           (setq cPt  (vlax-curve-getClosestPointto cEnt sPt)
                 lAng (angle cPt sPt)
                 bpt  (polar cPt lAng (/ (getvar "TEXTSIZE") 2.))
                 tpt  (polar bpt lAng tHgt)
                 mPt  (polar bPt lAng (/ tHgt 2.))
                 pt1  (polar bpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt2  (polar bPt (- lAng (/ pi 2.)) (/ tWid 2.))
                 pt3  (polar tpt (+ lAng (/ pi 2.)) (/ tWid 2.))
                 pt4  (polar tPt (- lAng (/ pi 2.)) (/ tWid 2.)))
           (grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4)))))
     (if (eq 3 (car gr))
       (progn
         (setq lAng (- lAng (/ pi 2.)))
         (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                (setq lAng (- lAng pi)))
               ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                (setq lAng (+ lAng pi))))
         (Make_Text mPt tStr lAng))))
   (princ "\n<!> Incorrect Selection <!>"))
 (redraw)
 (princ))

(defun Make_Text  (pt val rot)
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 (getvar "CLAYER"))
     (cons 62 2)
     (cons 10 pt)
     (cons 40 (getvar "TEXTSIZE"))
     (cons 1 val)
     (cons 50 rot)
     (cons 7 (getvar "TEXTSTYLE"))
     (cons 71 0)
     (cons 72 1)
     (cons 73 2)
     (cons 11 pt))))

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
Hi Steve,

 

Thanks for your praise, it is much appreciated. :D

 

What is the name of your block that you want to use? Or would you like the LISP to make the block from scratch?

 

Lee

 

LM, the name of the block is KEY-ITEM, the two attributes are named ITEM and QUANTITY. Attributes are not mtext.

 

Bobber is only moving with the wind !

Steve

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
LM, the name of the block is KEY-ITEM, the two attributes are named ITEM and QUANTITY. Attributes are not mtext.

 

Bobber is only moving with the wind !

Steve

 

OK, so if I am correct, you would like a prompt for a Description for the "Item" attribute, and the length of the line to the the "quantity" attribute.

 

Is this correct?

 

Also, would you like the block positioned above the line (like the text), or just anywhere in the drawing?

 

If it is above the line would you be able to post the block on here so that I could see dimensions and base points etc :)

 

Thanks

 

Lee

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
OK, so if I am correct, you would like a prompt for a Description for the "Item" attribute, and the length of the line to the the "quantity" attribute.

 

Is this correct?

 

Also, would you like the block positioned above the line (like the text), or just anywhere in the drawing?

 

If it is above the line would you be able to post the block on here so that I could see dimensions and base points etc :)

 

Thanks

 

Lee

 

Lee, maybe this idea will make it easier to program. Since the user will have to "pick" the line for which the length will have to come from, how about the block gets inserted at that same point ? (such as user picking the line "nea", "end", or "mid" or whatever.)

If user doesn't like block insertion point, then user can "move" it !

If it makes programming easier, user could always edit the "Item" attribute if it were inserted with some default as "Edit Item Please".

whatever is easy for you. I can hack it (fish) if you hang bait on hook for me.

Thanks, Steve

p.s. problem #2 with this code yet to come.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee, maybe this idea will make it easier to program. Since the user will have to "pick" the line for which the length will have to come from, how about the block gets inserted at that same point ? (such as user picking the line "nea", "end", or "mid" or whatever.)

If user doesn't like block insertion point, then user can "move" it !

If it makes programming easier, user could always edit the "Item" attribute if it were inserted with some default as "Edit Item Please".

whatever is easy for you. I can hack it (fish) if you hang bait on hook for me.

Thanks, Steve

p.s. problem #2 with this code yet to come.

 

 

No Problem Steve, I'll see what I can cook up for you :thumbsup:

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Steve, try this, I have experimented with the Block placement, let me know if it is suitable :thumbsup:

 

;; Align Block to Curve  ~ by Lee McDonnell (Lee Mac)
;; 29th May 2009

(defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk)
 (vl-load-com)

 (setq blkName "KEY-ITEM")
 
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop
                 (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32)))
 (or (eq 'STR (type blkName)) (setq blkName ""))
 (if (or (tblsearch "BLOCK" blkName)
         (findfile (strcat blkName ".dwg")))
   (if (and (setq cEnt (entsel "\nSelect Curve Object: "))
            (member
              (cdr (assoc 0 (entget (car cEnt))))
                '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE")))
     (progn
       (setq tmp (getstring t
                   (strcat "\nSpecify Block Description <"
                           (if (eq (chr 32) *PlBlk:Desc*)
                             "-None-" *PlBlk:Desc*) "> : ")))
       (or (not tmp) (setq *PlBlk:Desc* tmp))
       (setq cLen (- (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getEndParam
                         (car cEnt)))
                     (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getStartParam
                         (car cEnt))))
             blk (vla-insertBlock spc
                   (vlax-3D-point
                     (cadr cEnt)) "TEST BLOCK.dwg" 1. 1. 1. 0.))
       (if (eq :vlax-true
               (vla-get-HasAttributes blk))
         (foreach att (vlax-safearray->list
                        (vlax-variant-value
                          (vla-getAttributes blk)))
           (cond ((eq (vla-get-TagString att) "ITEM")
                  (vla-put-TextString att *PlBlk:Desc*))
                 ((eq (vla-get-TagString att) "QUANTITY")
                  (vla-put-TextString att
                    (rtos cLen)))))
         (princ "\n<< Block Has No Attributes to Fill >>"))
       (lmac-obj-drag-move "Position Block..." blk
         (vlax-ename->vla-object (car cEnt)) nil))
     (princ "\n<< No Curve Object Selected >>"))
   (princ "\n<< Block Not Found >>"))
 (princ))


;; Ghosting Example, by Lee McDonnell (Lee Mac)
;; Args:
;; msg ~ prompt      [str]
;; oBj ~ object      [ent/obj]
;; hi  ~ rubber band [t/nil]

(defun lmac-obj-drag-move  (msg oBj Cur hi /
                           oBj bsPt gr pt Ang)
 (vl-load-com)
 (if msg
   (prompt
     (strcat
       (if (not (vl-string-search "\n" msg))
         "\n""") msg)))
 (or (eq 'VLA-OBJECT (type oBj))
     (setq oBj
       (vlax-ename->vla-object oBj)))
 (if
   (vlax-property-available-p oBj 'InsertionPoint)
   (progn
     (if hi
       (setq bsPt
         (vlax-safearray->list
           (vlax-variant-value
             (vla-get-InsertionPoint oBj)))))
   (while
     (not
       (eq 3
         (car
           (setq gr (grread 't)))))
             (redraw)
     (if
       (and
         (eq 5 (car gr))
           (listp (cadr gr)))
       (progn
         (setq pt
           (vlax-curve-getClosestPointto Cur
             (cadr gr))
               Ang (angle pt (cadr gr)))
         (vla-put-Rotation oBj (- Ang (/ pi 2)))
         (vla-move oBj
           (vla-get-InsertionPoint oBj)
             (vlax-3D-point
               (polar pt Ang
                 (/ (getvar "TEXTSIZE") 2.))))
         (if hi
           (grdraw bsPt (cadr gr) 256 1)))))) nil)
 (redraw))

Link to comment
Share on other sites
stevesfr Rising Star

stevesfr

Posted
Posted
Steve, try this, I have experimented with the Block placement, let me know if it is suitable :thumbsup:

 

;; Align Block to Curve  ~ by Lee McDonnell (Lee Mac)
;; 29th May 2009

(defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk)
 (vl-load-com)

 (setq blkName "KEY-ITEM")

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop
                 (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32)))
 (or (eq 'STR (type blkName)) (setq blkName ""))
 (if (or (tblsearch "BLOCK" blkName)
         (findfile (strcat blkName ".dwg")))
   (if (and (setq cEnt (entsel "\nSelect Curve Object: "))
            (member
              (cdr (assoc 0 (entget (car cEnt))))
                '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE")))
     (progn
       (setq tmp (getstring t
                   (strcat "\nSpecify Block Description <"
                           (if (eq (chr 32) *PlBlk:Desc*)
                             "-None-" *PlBlk:Desc*) "> : ")))
       (or (not tmp) (setq *PlBlk:Desc* tmp))
       (setq cLen (- (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getEndParam
                         (car cEnt)))
                     (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getStartParam
                         (car cEnt))))
             blk (vla-insertBlock spc
                   (vlax-3D-point
                     (cadr cEnt)) "TEST BLOCK.dwg" 1. 1. 1. 0.))
       (if (eq :vlax-true
               (vla-get-HasAttributes blk))
         (foreach att (vlax-safearray->list
                        (vlax-variant-value
                          (vla-getAttributes blk)))
           (cond ((eq (vla-get-TagString att) "ITEM")
                  (vla-put-TextString att *PlBlk:Desc*))
                 ((eq (vla-get-TagString att) "QUANTITY")
                  (vla-put-TextString att
                    (rtos cLen)))))
         (princ "\n<< Block Has No Attributes to Fill >>"))
       (lmac-obj-drag-move "Position Block..." blk
         (vlax-ename->vla-object (car cEnt)) nil))
     (princ "\n<< No Curve Object Selected >>"))
   (princ "\n<< Block Not Found >>"))
 (princ))


;; Ghosting Example, by Lee McDonnell (Lee Mac)
;; Args:
;; msg ~ prompt      [str]
;; oBj ~ object      [ent/obj]
;; hi  ~ rubber band [t/nil]

(defun lmac-obj-drag-move  (msg oBj Cur hi /
                           oBj bsPt gr pt Ang)
 (vl-load-com)
 (if msg
   (prompt
     (strcat
       (if (not (vl-string-search "\n" msg))
         "\n""") msg)))
 (or (eq 'VLA-OBJECT (type oBj))
     (setq oBj
       (vlax-ename->vla-object oBj)))
 (if
   (vlax-property-available-p oBj 'InsertionPoint)
   (progn
     (if hi
       (setq bsPt
         (vlax-safearray->list
           (vlax-variant-value
             (vla-get-InsertionPoint oBj)))))
   (while
     (not
       (eq 3
         (car
           (setq gr (grread 't)))))
             (redraw)
     (if
       (and
         (eq 5 (car gr))
           (listp (cadr gr)))
       (progn
         (setq pt
           (vlax-curve-getClosestPointto Cur
             (cadr gr))
               Ang (angle pt (cadr gr)))
         (vla-put-Rotation oBj (- Ang (/ pi 2)))
         (vla-move oBj
           (vla-get-InsertionPoint oBj)
             (vlax-3D-point
               (polar pt Ang
                 (/ (getvar "TEXTSIZE") 2.))))
         (if hi
           (grdraw bsPt (cadr gr) 256 1)))))) nil)
 (redraw))

 

Lee, I got nowhere with this, why does it ask for block name when its defined as "Key-Item" in the beginning?

Program tilts bigtime with the following error...

; error: Automation Error. Filer error

can prog also be for line which is somewhat more benifical than arcs?

attached is key-item for your testing if needed.

KEY-ITEM.dwg

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Sorry, my mistake - I was previously testing it with a different block, and accidentally left that name in.

 

Try this:

 

;; Align Block to Curve  ~ by Lee McDonnell (Lee Mac)
;; 29th May 2009

(defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk)
 (vl-load-com)

 (setq blkName "KEY-ITEM")
 
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop
                 (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32)))
 (or (eq 'STR (type blkName)) (setq blkName ""))
 (if (or (tblsearch "BLOCK" blkName)
         (findfile (strcat blkName ".dwg")))
   (if (and (setq cEnt (entsel "\nSelect Curve Object: "))
            (member
              (cdr (assoc 0 (entget (car cEnt))))
                '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE")))
     (progn
       (setq tmp (getstring t
                   (strcat "\nSpecify Block Description <"
                           (if (eq (chr 32) *PlBlk:Desc*)
                             "-None-" *PlBlk:Desc*) "> : ")))
       (or (not tmp) (setq *PlBlk:Desc* tmp))
       (setq cLen (- (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getEndParam
                         (car cEnt)))
                     (vlax-curve-getDistatParam
                       (car cEnt)
                       (vlax-curve-getStartParam
                         (car cEnt))))
             blk (vla-insertBlock spc
                   (vlax-3D-point
                     (cadr cEnt)) (strcat blkName ".dwg") 1. 1. 1. 0.))
       (if (eq :vlax-true
               (vla-get-HasAttributes blk))
         (foreach att (vlax-safearray->list
                        (vlax-variant-value
                          (vla-getAttributes blk)))
           (cond ((eq (vla-get-TagString att) "ITEM")
                  (vla-put-TextString att *PlBlk:Desc*))
                 ((eq (vla-get-TagString att) "QUANTITY")
                  (vla-put-TextString att
                    (rtos cLen)))))
         (princ "\n<< Block Has No Attributes to Fill >>"))
       (lmac-obj-drag-move "Position Block..." blk
         (vlax-ename->vla-object (car cEnt)) nil))
     (princ "\n<< No Curve Object Selected >>"))
   (princ "\n<< Block Not Found >>"))
 (princ))


;; Ghosting Example, by Lee McDonnell (Lee Mac)
;; Args:
;; msg ~ prompt      [str]
;; oBj ~ object      [ent/obj]
;; hi  ~ rubber band [t/nil]

(defun lmac-obj-drag-move  (msg oBj Cur hi /
                           oBj bsPt gr pt Ang)
 (vl-load-com)
 (if msg
   (prompt
     (strcat
       (if (not (vl-string-search "\n" msg))
         "\n""") msg)))
 (or (eq 'VLA-OBJECT (type oBj))
     (setq oBj
       (vlax-ename->vla-object oBj)))
 (if
   (vlax-property-available-p oBj 'InsertionPoint)
   (progn
     (if hi
       (setq bsPt
         (vlax-safearray->list
           (vlax-variant-value
             (vla-get-InsertionPoint oBj)))))
   (while
     (not
       (eq 3
         (car
           (setq gr (grread 't)))))
             (redraw)
     (if
       (and
         (eq 5 (car gr))
           (listp (cadr gr)))
       (progn
         (setq pt
           (vlax-curve-getClosestPointto Cur
             (cadr gr))
               Ang (angle pt (cadr gr)))
         (vla-put-Rotation oBj (- Ang (/ pi 2)))
         (vla-move oBj
           (vla-get-InsertionPoint oBj)
             (vlax-3D-point
               (polar pt Ang
                 (/ (getvar "TEXTSIZE") 2.))))
         (if hi
           (grdraw bsPt (cadr gr) 256 1)))))) nil)
 (redraw))

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...