Jump to content

Select a dimension value as the height of the pyramid

Nikon

By Nikon
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Nikon Proficient

Nikon

Posted
Posted (edited)

This code allows you to select the height of the pyramid by pointing to the text in the drawing.

How can I change the code to select a dimension in the drawing to use the dimension value 
as the height of the truncated pyramid? 

(defun c:PyramidConeVolumeT (/ ent obj txt radius area1 area2 volume insPoint)
  (vl-load-com)

  (defun getHeightFromText ()
    (setq ent (entsel "\nSelect the text object containing the height: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (setq txt (vla-get-TextString obj))
    
     (setq height (distof txt 2))
  )

  (defun getCircleArea (circle)
    (setq radius (vla-get-Radius circle))
    (* pi radius radius)
  )

  (defun selectBase ()
    (setq ent (entsel "\nSelect a polyline or circle as the base: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (eq (vla-get-ObjectName obj) "AcDbCircle")
      (getCircleArea obj)
      (vlax-curve-getArea obj)
    )
  )

  (setq area1 (selectBase))
  (princ (strcat "\nArea A1: " (rtos area1 2 3)))

  (setq area2 (selectBase))
  (princ (strcat "\nArea A2: " (rtos area2 2 3)))

  (getHeightFromText)
  (princ (strcat "\nHeight H: " (rtos height 2 3)))

  ;; Calculating the volume in mm3
  (setq volume (* (/ height 3) (+ area1 (sqrt (* area1 area2)) area2)))

  ;; Converting volume to m3
  (setq volume_m3 (/ volume 1e9))
  (princ (strcat "\nThe volume of a truncated pyramid or cone (m3): " (rtos volume_m3 2 3)))

  (setq insPoint (getpoint "\nSpecify the insertion point of the result: "))
  (command "_.TEXT" insPoint "2.5" "0" (strcat "Volume (m3): " (rtos volume_m3 2 3)))
  (princ)
)

 

PyramidConeVolumeT.png

Edited by Nikon
  • Nikon changed the title to Select a dimension value as the height of the pyramid
GLAVCVS Proficient

GLAVCVS

Posted
Posted (edited)

Hi

Replacing your function with this one... is that enough? 

(defun getHeightFromText ()
  (setq ent (entsel "\nSelect the text object containing the height: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (if (= (setq to (CDR (ASSOC 0 (entget (car ent))))) "TEXT")
    (setq txt (vla-get-TextString obj))
    (if (= to "DIMENSION")
      (if (= (setq txt (vla-get-textOverride obj)) "")
        (setq txt (rtos (vla-get-measurement obj) 2 2))
        txt
      )
      (progn (alert "No valid object") nil)
    )
  )
  (setq height (distof txt 2))
)

 

Edited by GLAVCVS
  • Thanks 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

You may need to copy the code again: I changed something.

  • Thanks 1
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
On 4/17/2025 at 1:42 PM, GLAVCVS said:

You may need to copy the code again: I changed something.

I'm missing something...
The code works on the first download.
When called again, the command does not work.
PYRAMIDCONEVOLUMETDIM
GETHEIGHTFROMTEXT??? 

(defun c:PyramidConeVolumeTDIM (/ ent obj txt radius area1 area2 volume insPoint)
  (vl-load-com)

(defun getHeightFromText ()
  (setq ent (entsel "\nSelect the text object containing the height: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (if (= (setq to (CDR (ASSOC 0 (entget (car ent))))) "TEXT")
    (setq txt (vla-get-TextString obj))
    (if (= to "DIMENSION")
      (if (= (setq txt (vla-get-textOverride obj)) "")
        (setq txt (rtos (vla-get-measurement obj) 2 2))
        txt
      )
      (progn (alert "No valid object") nil)
    )
  )
  (setq height (distof txt 2))
)
    
  )

  (defun getCircleArea (circle)
    (setq radius (vla-get-Radius circle))
    (* pi radius radius)
  )

  (defun selectBase ()
    (setq ent (entsel "\nSelect a polyline or circle as the base: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (eq (vla-get-ObjectName obj) "AcDbCircle")
      (getCircleArea obj)
      (vlax-curve-getArea obj)
    )
  )

  (setq area1 (selectBase))
  (princ (strcat "\nArea A1: " (rtos area1 2 3)))

  (setq area2 (selectBase))
  (princ (strcat "\nArea A2: " (rtos area2 2 3)))

  (getHeightFromText)
  (princ (strcat "\nHeight H: " (rtos height 2 3)))

  ;; Calculating the volume in mm3
  (setq volume (* (/ height 3) (+ area1 (sqrt (* area1 area2)) area2)))

  ;; Converting volume to m3
  (setq volume_m3 (/ volume 1e9))
  (princ (strcat "\nThe volume of a truncated pyramid or cone (m3): " (rtos volume_m3 2 3)))

  (setq insPoint (getpoint "\nSpecify the insertion point of the result: "))
  (command "_.TEXT" insPoint "2.5" "0" (strcat "Volume (m3): " (rtos volume_m3 2 3)))

  (princ)
)

 

Edited by Nikon
GLAVCVS Proficient

GLAVCVS

Posted
Posted

An example drawing will help to find a solution faster.

Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
8 minutes ago, GLAVCVS said:

An example drawing will help to find a solution faster.

 

PyramidConeVolumeT.dwg

Edited by Nikon
GLAVCVS Proficient

GLAVCVS

Posted
Posted
52 minutes ago, Nikon said:

I'm missing something...
The code works on the first download.
When the command is called again, it appears.
When called again, the command does not work.
PYRAMIDCONEVOLUMETDIM
GETHEIGHTFROMTEXT??? 

(defun c:PyramidConeVolumeTDIM (/ ent obj txt radius area1 area2 volume insPoint)
  (vl-load-com)

(defun getHeightFromText ()
  (setq ent (entsel "\nSelect the text object containing the height: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (if (= (setq to (CDR (ASSOC 0 (entget (car ent))))) "TEXT")
    (setq txt (vla-get-TextString obj))
    (if (= to "DIMENSION")
      (if (= (setq txt (vla-get-textOverride obj)) "")
        (setq txt (rtos (vla-get-measurement obj) 2 2))
        txt
      )
      (progn (alert "No valid object") nil)
    )
  )
  (setq height (distof txt 2))
)
    
  )

  (defun getCircleArea (circle)
    (setq radius (vla-get-Radius circle))
    (* pi radius radius)
  )

  (defun selectBase ()
    (setq ent (entsel "\nSelect a polyline or circle as the base: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (eq (vla-get-ObjectName obj) "AcDbCircle")
      (getCircleArea obj)
      (vlax-curve-getArea obj)
    )
  )

  (setq area1 (selectBase))
  (princ (strcat "\nArea A1: " (rtos area1 2 3)))

  (setq area2 (selectBase))
  (princ (strcat "\nArea A2: " (rtos area2 2 3)))

  (getHeightFromText)
  (princ (strcat "\nHeight H: " (rtos height 2 3)))

  ;; Calculating the volume in mm3
  (setq volume (* (/ height 3) (+ area1 (sqrt (* area1 area2)) area2)))

  ;; Converting volume to m3
  (setq volume_m3 (/ volume 1e9))
  (princ (strcat "\nThe volume of a truncated pyramid or cone (m3): " (rtos volume_m3 2 3)))

  (setq insPoint (getpoint "\nSpecify the insertion point of the result: "))
  (command "_.TEXT" insPoint "2.5" "0" (strcat "Volume (m3): " (rtos volume_m3 2 3)))

  (princ)
)

 

 

You've moved a lot of things around in this code compared to the original you posted.
So it's hard to get it to work.

  • Agree 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

Here: your code modified to make it work.

But there's one problem: you haven't specified the volume calculations correctly.

I think I should leave this to you. 

(defun c:PyramidConeVolumeT (/ ent obj txt radius area1 area2 volume insPoint to)
  (vl-load-com)
  (defun getHeightFromText ()
    (setq ent (entsel "\nSelect the text object containing the height: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if	(= (setq to (CDR (ASSOC 0 (entget (car ent))))) "TEXT")
      (setq txt (vla-get-TextString obj))
      (if (= to "DIMENSION")
	(if (= (setq txt (vla-get-textOverride obj)) "")
	  (setq txt (rtos (vla-get-measurement obj) 2 2))
	  txt
	)
	(progn (alert "No valid object") nil)
      )
    )
    (setq height (distof txt 2))
  )
  (defun getCircleArea (circle)
    (setq radius (vla-get-Radius circle))
    (* pi radius radius)
  )
  (defun selectBase ()
    (setq ent (entsel "\nSelect a polyline or circle as the base: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (eq (vla-get-ObjectName obj) "AcDbCircle")
      (getCircleArea obj) (vlax-curve-getArea obj)
    )
  )
  (setq area1 (selectBase))
  (princ (strcat "\nArea A1: " (rtos area1 2 3)))
  (setq area2 (selectBase))
  (princ (strcat "\nArea A2: " (rtos area2 2 3)))
  (getHeightFromText)
  (princ (strcat "\nHeight H: " (rtos height 2 3))) ;; Calculating the volume in mm3
  (setq volume (* (/ height 3) (+ area1 (sqrt (* area1 area2)) area2))) ;; Converting volume to m3
  (setq volume_m3 (/ volume 1e9))
  (princ (strcat "\nThe volume of a truncated pyramid or cone (m3): " (rtos volume_m3 2 3)))
  (setq insPoint (getpoint "\nSpecify the insertion point of the result: "))
  (command "_.TEXT" insPoint "2.5" "0" (strcat "Volume (m3): " (rtos volume_m3 2 3)))
  (princ)
)

 

  • Like 1
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
8 minutes ago, GLAVCVS said:

Here: your code modified to make it work.

But there's one problem: you haven't specified the volume calculations correctly.

I think I should leave this to you.

It works perfectly! Thank you very much!

I'll check the formula...

Edited by Nikon
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
3 hours ago, GLAVCVS said:

But there's one problem: you haven't specified the volume calculations correctly.

If you hurry, you'll make people laugh...😀
I am replacing the formula string with
(setq volume (/ (* height (+ area1 area2 (sqrt (* area1 area2)))) 3))
The code now works like a Swiss watch. 

;; Thanks GLAVCVS 17.04.2025
;; https://www.cadtutor.net/forum/topic/97474-select-a-dimension-value-as-the-height-of-the-pyramid/
;; Calculating the volume of a truncated pyramid or a truncated cone  /_\   \_/
(defun c:PyramidConeVolumeTDIM (/ ent obj txt radius area1 area2 volume insPoint to)
  (vl-load-com)
  (defun getHeightFromText ()
    (setq ent (entsel "\nSelect the text object containing the height: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if	(= (setq to (CDR (ASSOC 0 (entget (car ent))))) "TEXT")
      (setq txt (vla-get-TextString obj))
      (if (= to "DIMENSION")
	(if (= (setq txt (vla-get-textOverride obj)) "")
	  (setq txt (rtos (vla-get-measurement obj) 2 2))
	  txt
	)
	(progn (alert "No valid object") nil)
      )
    )
    (setq height (distof txt 2))
  )
  (defun getCircleArea (circle)
    (setq radius (vla-get-Radius circle))
    (* pi radius radius)
  )
  (defun selectBase ()
    (setq ent (entsel "\nSelect a polyline or circle as the base: "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (if (eq (vla-get-ObjectName obj) "AcDbCircle")
      (getCircleArea obj) (vlax-curve-getArea obj)
    )
  )
  (setq area1 (selectBase))
  (princ (strcat "\nArea A1: " (rtos area1 2 3)))
  (setq area2 (selectBase))
  (princ (strcat "\nArea A2: " (rtos area2 2 3)))
  (getHeightFromText)
  (princ (strcat "\nHeight H: " (rtos height 2 3))) ;; Calculating the volume in mm3
   (setq volume (/ (* height (+ area1 area2 (sqrt (* area1 area2)))) 3))

  (setq volume_m3 (/ volume 1e9))
  (princ (strcat "\nThe volume of a truncated pyramid or cone (m3): " (rtos volume_m3 2 3)))
  (setq insPoint (getpoint "\nSpecify the insertion point of the result: "))
  (command "_.TEXT" insPoint "2.5" "0" (strcat "Volume (m3): " (rtos volume_m3 2 3)))
  (princ)
)

 

Edited by Nikon
  • Like 1

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