Jump to content

Recommended Posts

Posted

Yes I am using LDD and Civil 3D Autocad 2006 product, I tried your code Lee and it works beautifully, you are the bomb, you do not know how much I appreciate it.

  • Replies 66
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    23

  • CadProWannabe

    12

  • eldon

    8

  • wizman

    8

Top Posters In This Topic

Posted Images

Posted
Yes I am using LDD and Civil 3D Autocad 2006 product, I tried your code Lee and it works beautifully, you are the bomb, you do not know how much I appreciate it.

 

Thanks for your kind words, you're welcome :)

  • 5 years later...
Posted
...

 

This is what the other lisp routine does that I use.

 

1. activate the command

2. select point block from Node (which is set at 0.00 elevation)

3. extracts the description and elevation and places a line between the two text entities and the end of the line is attached to the node of the point block.

 

...

 

CadPro...:

 

Would you'd be willing to share the "other" lisp routine you refer to?

 

Or, would anyone else be able to create one?

 

I've been attempting to create a routine which will accomplish this goal but have had limited success, and by "limited" I mean none at all.

 

Still using ACAD2002. :thumbsup:

Posted

CadPro last posted in July, 2014. You may have to speak louder for him to hear you.

Posted

Lol, I saw that as well. Too bad I can't find a way to email him.

 

Perhaps I'll get lucky and come up with a Frankenstein program of my own.

  • 7 years later...
Posted
On 1/16/2010 at 11:09 PM, Lee Mac said:

Try this one:

 

 

(defun c:tpt (/ Make_Text pt BoxNum BoxHgt BoxWid)
 ;; Lee Mac, David Bethel & Wizman  ~  10.01.10 (= 38)
 
 (setvar 'dimzin 0)
  
 (defun Make_Text (pt val)

   (setq pt1 (polar pt (atan BoxHgt   (* BoxNum BoxWid)) 
                       (sqrt (+ (expt (* BoxNum BoxWid) 2)
                                (expt BoxHgt 2)))))
   
   (entmakex (list (cons 0   "MTEXT")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbMText")
                   (cons 71 3)
                   (list 10 (car pt1) (cadr pt1) (caddr pt))
                   (cons 40 (getvar 'TEXTSIZE))
                   (cons 1  (strcat "{\\fMonospac821 BT|b0|i0|c0|p49;" val "}")))))

 (setq BoxNum (+ 0.412636   (getvar 'LUPREC))
       BoxHgt (* 0.892748   (getvar 'TEXTSIZE))
       BoxWid (* (/ 13 15.) (getvar 'TEXTSIZE)))

 (while (setq pt (getpoint "\nPick Point: "))
   (Make_Text pt (rtos (caddr (trans pt 1 0)))))

 (princ))
 

 

hi lee

how to change this code for labeling multiple points automatically.

Posted
(defun C:lbpo ( / ss i ename ent ptcord zvalue)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq txth(getreal"\n enter text height"))
  (command "._undo" "_BE") 

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "cmdecho" 0)

(setq clyr(getvar"clayer"))
  
(setq ss (ssget '((0 . "point,INSERT"))))
(setq i 0)
  (repeat (fix (sslength ss))
    (acet-ui-progress-init "processing file:" (sslength ss))
    (acet-ui-progress-safe i)
    (setq ename (ssname ss i))
    (setq ent (entget ename))
    (setq ptcord (cdr (assoc 10 ent)))
    (setq zvalue(caddr ptcord))
    (setq osmd(getvar"osmode"))
    (setvar"osmode"0)
    ;;;;;;;;;;;;;;;;;;;;;;;;ncreat ch at p
	     (entmakex (list '(0 . "TEXT")
                             '(100 . "AcDbEntity")
                             '(67 . 0)
                             '(8 . "Elevation")
                             '(100 . "AcDbText")
                             (cons 10 ptcord)
                             (cons 40 txth)
                             (cons 1 (rtos zvalue 2 2))
                             (cons 50 0)
                             '(41 . 1.0)
                             '(51 . 0.3)
			     '(62 . 3)
                             '(7 . "Standard")
                             '(71 . 0)
                             '(72 . 0)
                             (cons 11 (list 0.0 0.0 zvalue))
                             '(100 . "AcDbText")
                             '(73 . 0)
                       )
             )
             ;; 
    
    (setq i (1+ i))
    
  )
  (acet-ui-progress-done)
  (setvar"clayer"clyr)
  (setvar"osmode"osmd)
  (command "._undo" "_END") 
)

this is mine for multiple points

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.


×
×
  • Create New...