Jump to content

floor & height lsp

sachindkini

By sachindkini
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

sachindkini Collaborator

sachindkini

Posted
Posted

floor height & floor Numbering in 2d section & elevation lsp

section.jpg

Lee Mac Grand Master

Lee Mac

Posted
Posted

Hello, and welcome to CADTutor sachindkini.

 

I am assuming you would like someone to create such a LISP for you - but just stating the name of a LISP in your thread is not a very polite way of requesting such a LISP in my opinion.

 

As you're new, I'll have a look.

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok, ignore my last post - I have accounted for both polylines and lines:

 

; Multiple Floor Height by Lee McDonnell 14th January 2009

; Places Height and Floor Text above Midpoint on Floor Level Line.

; [if Polyline, Assumes only two Vertices.]

; [Assumes Lines are Parallel]

(defun c:fht (/ varlist oldvars cCurve cVlist cAng cMpt cStpt cEnpt dCurve fStr dVlist dStpt dEnpt dAng)
   
   (vl-load-com)
   (setq varlist (list "CMDECHO" "CLAYER")
     oldvars (mapcar 'getvar varlist))
   (setvar "CMDECHO" 0)
  (if (and (setq cCurve (car (entsel "\nSelect Ground Floor >   ")))
        (member (cdr (assoc 0 (entget cCurve)))
           '("LINE" "LWPOLYLINE")))
      (progn
      (if (not (tblsearch "LAYER" "TEXT"))
          (vl-cmdf "-layer" "M" "TEXT" "C" "2" "TEXT" ""))
      (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve))))
         (setq cVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget cCurve)))
           cAng (angle (nth 0 cVlist)(nth 1 cVlist))
           cMpt (polar (nth 0 cVlist) cAng (/ (distance (nth 0 cVlist)(nth 1 cVlist)) 2)))
         (if (>= cAng pi) (setq cAng (- cAng pi)))
         (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt.  Gr. Level" cAng))
        ((= "LINE" (cdr (assoc 0 (entget cCurve))))
         (setq cStpt (cdr (assoc 10 (entget cCurve)))
           cEnpt (cdr (assoc 11 (entget cCurve)))
            cAng (angle cStpt cEnpt)
           cMpt (polar cStpt cAng (/ (distance cStpt cEnpt) 2)))
         (if (> cAng pi) (setq cAng (- cAng pi)))
         (if (= cAng pi) (setq cAng 0.0))
         (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt.   Gr. Level" cAng)))
      (while (and (setq dCurve (car (entsel "\nSelect a Floor >   ")))
               (member (cdr (assoc 0 (entget dCurve)))
                   '("LINE" "LWPOLYLINE"))
              (/= (setq fStr (getstring t "\nSpecify Name of Floor >   ")) ""))
          (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget dCurve))))
             (setq dVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget dCurve)))
               dAng (angle (nth 0 dVlist)(nth 1 dVlist))
               cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt))
             (Make_Text (polar cMpt (+ cAng (/ pi 2)) (+ cdDist 2))
               (strcat "+" (rtos cdDist 2 2) " Mt.   " fStr) cAng))
            ((= "LINE" (cdr (assoc 0 (entget dCurve))))
             (setq dStpt (cdr (assoc 10 (entget dCurve)))
               dEnpt (cdr (assoc 11 (entget dCurve)))
                dAng (angle dStpt dEnpt)
               cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt))
             (Make_Text (polar cMpt (+ cAng (/ pi 2)) (+ cdDist 2))
                 (strcat "+" (rtos cdDist 2 2) " Mt.   " fStr) cAng)))))
      (princ "\n<!> No Floor Selected <!> "))
   (mapcar 'setvar varlist oldvars)
   (princ))

(defun Make_Text (txt_pt txt_val txt_ang)
   (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txt_pt) (cons 40 (max 2.5 (getvar "TEXTSIZE")))
   (cons 1 txt_val) (cons 50 txt_ang) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txt_pt))))

The above will prompt for the selection of a Ground Floor line (either 2D polyline or Line) and then continue to prompt for subsequent floor level selections and names. The Levels can be at any angle, and, if not parallel, the distance will be to the closest point.

 

See example attached.

 

Cheers

 

Lee

Level Marker.zip

sachindkini Collaborator

sachindkini

Posted
  • Author
Posted

thanks sir

 

u done very good job

 

thnx lot

Lee Mac Grand Master

Lee Mac

Posted
Posted

Edit to my original post:

 

The point is measured from the midpoint of the ground floor line - thus, if the lines are not parallel, the distance measured will be the closest to the midpoint, not to the line.

 

Also, if the lines are not parallel, the text will be set at the angle of the base line, not that of the top line - I shall endeavor to fix these bugs.

Example.jpg

Lee Mac Grand Master

Lee Mac

Posted
Posted

Ok, So I have accounted for the subsequent floors not being level. - takes quite a bit of playing around with the angles and conditional statements depending on the angle of the floor level, but I got there in the end..

 

The hard part is that the floor lines can be drawn from either side, and so the angle measured is either say, "x" when drawn from left to right or (x + pi) when drawn from right to left.

 

See example for how I have overcome this. - again though, distances are measured from the midpoint of the ground floor line - to the closest point on the floor level (i.e. the perpendicular).

 

; Multiple Floor Height by Lee McDonnell 14th January 2009

; Places Height and Floor Text above Midpoint on Floor Level Line.

; [if Polyline, Assumes only two Vertices.]

; [Assumes Lines are Parallel]

(defun c:fht (/ varlist oldvars cCurve cVlist cAng cMpt cStpt cEnpt dCurve fStr dVlist dStpt dEnpt dAng)
   
   (vl-load-com)
   (setq varlist (list "CMDECHO" "CLAYER")
     oldvars (mapcar 'getvar varlist))
   (setvar "CMDECHO" 0)
  (if (and (setq cCurve (car (entsel "\nSelect Ground Floor >   ")))
        (member (cdr (assoc 0 (entget cCurve)))
           '("LINE" "LWPOLYLINE")))
      (progn
      (if (not (tblsearch "LAYER" "TEXT"))
          (vl-cmdf "-layer" "M" "TEXT" "C" "2" "TEXT" ""))
      (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve))))
         (setq cVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget cCurve)))
           cAng (angle (nth 0 cVlist)(nth 1 cVlist))
           cMpt (polar (nth 0 cVlist) cAng (/ (distance (nth 0 cVlist)(nth 1 cVlist)) 2)))
         (if (>= cAng pi) (setq cAng (- cAng pi)))
         (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt.  Gr. Level" cAng))
        ((= "LINE" (cdr (assoc 0 (entget cCurve))))
         (setq cStpt (cdr (assoc 10 (entget cCurve)))
           cEnpt (cdr (assoc 11 (entget cCurve)))
            cAng (angle cStpt cEnpt)
           cMpt (polar cStpt cAng (/ (distance cStpt cEnpt) 2)))
         (if (> cAng pi) (setq cAng (- cAng pi)))
         (if (= cAng pi) (setq cAng 0.0))
         (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt.   Gr. Level" cAng)))
      (while (and (setq dCurve (car (entsel "\nSelect a Floor >   ")))
               (member (cdr (assoc 0 (entget dCurve)))
                   '("LINE" "LWPOLYLINE"))
              (/= (setq fStr (getstring t "\nSpecify Name of Floor >   ")) ""))
          (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget dCurve))))
             (setq dVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget dCurve)))
               dAng (angle (nth 0 dVlist)(nth 1 dVlist))
       cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt))
       (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi)))
             ((= dAng pi) (setq dAng 0.0)))
             (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2))
               (strcat "+" (rtos cdDist 2 2) " Mt.   " fStr) dAng))
            ((= "LINE" (cdr (assoc 0 (entget dCurve))))
             (setq dStpt (cdr (assoc 10 (entget dCurve)))
               dEnpt (cdr (assoc 11 (entget dCurve)))
                dAng (angle dStpt dEnpt)
       cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt))
          (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi)))
             ((= dAng pi) (setq dAng 0.0)))
             (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2))
                 (strcat "+" (rtos cdDist 2 2) " Mt.   " fStr) dAng)))))
      (princ "\n<!> No Floor Selected <!> "))
   (mapcar 'setvar varlist oldvars)
   (princ))

(defun Make_Text (txt_pt txt_val txt_ang)
   (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txt_pt) (cons 40 (max 2.5 (getvar "TEXTSIZE")))
   (cons 1 txt_val) (cons 50 txt_ang) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txt_pt))))

Example2.jpg

sachindkini Collaborator

sachindkini

Posted
  • Author
Posted

i load the lisp file but problem is text insert is middle of line

& some file text rotate in 180 dgree

 

and onter help

chage floor height manual change the every floor height

define text layer, text height & text style

im using autocad 2008 & 2009

sorry for bad english

 

thnx

Lee Mac Grand Master

Lee Mac

Posted
Posted
i load the lisp file but problem is text insert is middle of line

& some file text rotate in 180 dgree

 

and onter help

chage floor height manual change the every floor height

define text layer, text height & text style

im using autocad 2008 & 2009

sorry for bad english

 

thnx

 

 

Did you load the newly posted LISP? ~ as shown in the example, all works fine on my machine.

 

As for changing one floor height and needing to change every floor height, this shouldn't be the case as all the height are measured from the ground floor +/- 0.00 and are not relative, - you should only need to re-do one floor.

 

As for the layers and text heights and styles, these can all be changed very easily - what do you require?

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