lisp to insert 3dblock with alignment

S_S_SS · ‎04-13-2025

Hello everyone
I've made a lisp that aim to insert 3d block with specific alignment (the first and second points)

i've make it to get the base point of the block and also i put point parameter in the block "position1" with the Mr. lee mac lisp (LM:getdynpropvalue)
and make the align about the pt1 ,pt2, basepoint and ,position01

1-i noticed that the "position01" is about the block in the block editor .

2-and it insert the block but to make the alignment it asks me again to select the points to make the alignment .

can someone help me about this
kindly see the attached lisp and DWG .
and thanks in advance .

;; The LM:getdynpropvalue function definition from Lee Mac
(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)
;***********************************************************
(defun c:770 (ent / obj posx posy)
  ;; Check if ent is provided; otherwise prompt for selection
  (if (not ent)
    (setq ent (car (entsel "\nSelect a dynamic block: ")))
  )

  ;; Verify if it's a valid entity and a block reference
  (if (and ent (eq (cdr (assoc 0 (entget ent))) "INSERT"))
    (progn
      ;; Get the VLA object of the entity
      (setq obj (vlax-ename->vla-object ent))
      
      ;; Retrieve the Position1 property value
      (if (and
	    (setq posx (LM:getdynpropvalue obj "Position1 X"))
	    (setq posy (LM:getdynpropvalue obj "Position1 Y"))
      ; (setq posz (LM:getdynpropvalue obj "Position1 Z"))

	  )
        (list posx posy 0)  ; Return coordinates as a list
        nil               ; Return nil if not found
      )
    )
  )
)

;**********************************************

(defun c:I4 ( / pt1 pt2 dist blockName ent blk basePos position01 ptB ptP)
  (setq pt1 (getpoint "\nSelect the first point: "))
  (setq pt2 (getpoint pt1 "\nSelect the second point: "))

  (if (and pt1 pt2)
    (progn
      ;; calculate the distance 
      (setq dist (distance pt1 pt2))

      ;; select the required block 
      (cond
        ((< dist 1000) (setq blockName "TUBE_1.0M"))
        ((< dist 1500) (setq blockName "TUBE_1.50M"))
        ((< dist 2000) (setq blockName "TUBE_2.0M"))
        ((< dist 2500) (setq blockName "TUBE_2.5M"))
        ((< dist 3000) (setq blockName "TUBE_3.0M"))
        ((< dist 3500) (setq blockName "TUBE_3.5M"))
        ((< dist 4000) (setq blockName "TUBE_4.0M"))
        ((< dist 4500) (setq blockName "TUBE_4.5M"))
        ((< dist 5000) (setq blockName "TUBE_5.0M"))
        ((< dist 5500) (setq blockName "TUBE_5.5M"))
        ((< dist 6000) (setq blockName "TUBE_6.0M"))
        ((>= dist 6000) (setq blockName "TUBE_6.0M"))
      )

      ;; insert the block in pt1
      (command "_insert" blockName pt1 1.0 1.0 1.0 0)
      
      (command "_regen") ;; 
      
      (setq ent (entlast))
      

      
      (setq blk (vlax-ename->vla-object ent))
      


   ;base pont of the block 
      (setq basePos (vlax-get blk 'InsertionPoint)) ;; list: (x y z)
      
      ; (alert (strcat "base point is " (vl-princ-to-string basePos)))
      
      ; (princ)
      ; (sssetfirst nil ent)

   ;;position1 
      (setq position01 (c:770 ent)) ;; list: (dx dy dz)
      
      

      ; (setq ptB (LIST (CAR basePos) (CADR basePos))) ;; Base Point
      
            (setq ptB basePos) ;; Base Point

      
      
      
      ; (setq ptP (mapcar '+ basePos position01)) ;;real  Position1 

      ; (command "_.align" ent
      ;          ptB ptP 
      ;          pt1 pt2 
      ;          ""
      ;          "")
      
      
      ; (command "_.align" ent
      ;    ptB pt1
      ;    ptP pt2
      ;    ""
      ;    ""
         
      ; )
      
      ; (SETQ PT11 (LIST (CAR PT1) (CADR PT1)))
      ; (SETQ PT12 (LIST (CAR PT2) (CADR PT2)))


 (setq ptB (trans ptB 1 0)) ;form wcs to ucs 
 (setq position01 (trans position01 1 0))
 (setq pt1 (trans pt1 1 0))
 (setq pt2 (trans pt2 1 0))

  ;;check
      (alert (strcat 
        "\nbasePos: " (vl-princ-to-string ptB)
        "\nposition01: " (vl-princ-to-string position01)
        "\npt1: " (vl-princ-to-string PT1)
        "\npt2: " (vl-princ-to-string PT2)
      ))

      
      
      

;  (vl-cmdf "_.ALIGN" ent
;            ptB pt1
;            position01 pt2
;          ""
;          "")
      


      (princ (strcat "\nDonne " blockName))
    )
    (princ "\nError in pt1 or pt2")
  )
  (princ)
)

Kent1Cooper · ‎04-13-2025

You have three aligning commands, all commented out. Which are you using?

One thing I notice: When using the C: prefix in defining a function:

(defun c:770 (ent / obj posx posy)

it becomes a command name that can be entered at the command prompt, but you're not using it that way, and most importantly [from Help, >here<]:

Functions that are defined as commands should not accept arguments directly....

That means nothing before slash in the function heading line. Your 770 function should be without the C:, both where defined and where used taking an argument [your ent]:

....
(defun 770 (ent / obj posx posy)
....
   ;;position1 
      (setq position01 (770 ent)) ;; list: (dx dy dz)
....

I haven't evaluated your code in enough detail to know whether that will answer your question, but as a first step, try it that way.

Kent Cooper, AIA

S_S_SS · ‎04-13-2025

okay thanks sir for your information
i also fixed the align command
but still now the error
can you help me to fix this ?

;; The LM:getdynpropvalue function definition from Lee Mac
(defun LM:getdynpropvalue ( blk prp )
    (setq prp (strcase prp))
    (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)


;****************************************************************

(defun get_point_parameter (ent / obj posx posy)
  ;; Check if ent is provided; otherwise prompt for selection
  (if (not ent)
    (setq ent (car (entsel "\nSelect a dynamic block: ")))
  )

  ;; Verify if it's a valid entity and a block reference
  (if (and ent (eq (cdr (assoc 0 (entget ent))) "INSERT"))
    (progn
      ;; Get the VLA object of the entity
      (setq obj (vlax-ename->vla-object ent))
      
      ;; Retrieve the Position1 property value
      (if (and
	    (setq posx (LM:getdynpropvalue obj "Position1 X"))
	    (setq posy (LM:getdynpropvalue obj "Position1 Y"))
      ; (setq posz (LM:getdynpropvalue obj "Position1 Z"))

	  )
        (list posx posy 0)  ; Return coordinates as a list
        nil               ; Return nil if not found
      )
    )
  )
)


;***********************************************************************
(defun get-Position1 (ent / obj posx posy posz)
  (if (and ent (eq (cdr (assoc 0 (entget ent))) "INSERT"))
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (if (and
            (setq posx (LM:getdynpropvalue obj "Position1 X"))
            (setq posy (LM:getdynpropvalue obj "Position1 Y"))
            (setq posz (LM:getdynpropvalue obj "Position1 Z"))
          )
        (list posx posy posz)
        nil
      )
    )
  )
)
;******************************************************************
(defun c:I4 ( / pt1 pt2 dist blockName ent blk basePos position01 ptB ptP)
  (setq pt1 (getpoint "\nSelect the first point: "))
  (setq pt2 (getpoint pt1 "\nSelect the second point: "))

  (if (and pt1 pt2)
    (progn
      ;; calculate the distance 
      (setq dist (distance pt1 pt2))

      ;; select the required block 
      (cond
        ((< dist 1000) (setq blockName "TUBE_1.0M"))
        ((< dist 1500) (setq blockName "TUBE_1.50M"))
        ((< dist 2000) (setq blockName "TUBE_2.0M"))
        ((< dist 2500) (setq blockName "TUBE_2.5M"))
        ((< dist 3000) (setq blockName "TUBE_3.0M"))
        ((< dist 3500) (setq blockName "TUBE_3.5M"))
        ((< dist 4000) (setq blockName "TUBE_4.0M"))
        ((< dist 4500) (setq blockName "TUBE_4.5M"))
        ((< dist 5000) (setq blockName "TUBE_5.0M"))
        ((< dist 5500) (setq blockName "TUBE_5.5M"))
        ((< dist 6000) (setq blockName "TUBE_6.0M"))
        ((>= dist 6000) (setq blockName "TUBE_6.0M"))
      )

      ;; insert the block in pt1
      (command "_insert" blockName pt1 1.0 1.0 1.0 0)
      
      (command "_regen") ;; 
      
      (setq ent (entlast))
      

      
      (setq blk (vlax-ename->vla-object ent))
      


   ;base pont of the block 
      (setq basePos (vlax-get blk 'InsertionPoint)) ;; list: (x y z)
      
      ; (alert (strcat "base point is " (vl-princ-to-string basePos)))
      
      ; (princ)
      ; (sssetfirst nil ent)

   ;;position1 
      (setq position01 (get_point_parameter ent)) ;; list: (dx dy dz)
      
      

      ; (setq ptB (LIST (CAR basePos) (CADR basePos))) ;; Base Point
      
            (setq ptB basePos) ;; Base Point

      
      
      
      ; (setq ptP (mapcar '+ basePos position01)) ;;real  Position1 

      ; (command "_.align" ent
      ;          ptB ptP 
      ;          pt1 pt2 
      ;          ""
      ;          "")
      
      
      ; (command "_.align" ent
      ;    ptB pt1
      ;    ptP pt2
      ;    ""
      ;    ""
         
      ; )
      
      ; (SETQ PT11 (LIST (CAR PT1) (CADR PT1)))
      ; (SETQ PT12 (LIST (CAR PT2) (CADR PT2)))


 (setq ptB (trans ptB 1 0)) ;form wcs to ucs 
 (setq position01 (trans position01 1 0))
 (setq pt1 (trans pt1 1 0))
 (setq pt2 (trans pt2 1 0))

  ;;check
      (alert (strcat 
        "\nbasePos: " (vl-princ-to-string ptB)
        "\nposition01: " (vl-princ-to-string position01)
        "\npt1: " (vl-princ-to-string PT1)
        "\npt2: " (vl-princ-to-string PT2)
      ))

      
      
      

 (vl-cmdf "_.ALIGN" ent
           ptB pt1
           position01 pt2
         ""
         "")
      


      (princ (strcat "\nDonne " blockName))
    )
    (princ "\nError in pt1 or pt2")
  )
  (princ)
)

o

Kent1Cooper · ‎04-14-2025

(vl-cmdf "_.ALIGN" ent

I think you need to complete object selection:

(vl-cmdf "_.ALIGN" ent ""

Kent Cooper, AIA

S_S_SS · ‎04-14-2025

Can you illustrate more details

S_S_SS · ‎04-15-2025

Sir

I have repaired the syntax of the align

And add "n" instead of "" in the last of the function

But it still require to select the points in the align command

How to fix this??

Community

lisp to insert 3dblock with alignment

lisp to insert 3dblock with alignment

lisp to insert 3dblock with alignment