3D rotate block from the base point and the other point of the blok ?

[dr.hybride]

Very good job @lrm thank you very much

 

a last thing, is it possible to do the same thing for several block at one time ?

 

have good day

 

[lrm]

@dr.hybride you are welcome.

 

The following program should work on multiple blocks. I stole some code from @rlx for going through a selection list and replaced the nentsel function with nentselp which interestingly transposes the matrix that nentsel uses.  The following functions should work but may have a problem if two objects have the same insertion point.

(defun c:rot90x (/ sel idx lst obj m xdir basept blk refpt)
  ; rotates a blocks by 90° about their x axis.
  ; lrm 4/29/2021
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq sel (ssget "_:L" '((0 . "INSERT"))))
  (repeat (setq idx (sslength sel))
    (setq lst
	   (cons
	     (cons (setq
		     obj
		      (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
		   )
		   (vlax-get obj 'insertionpoint)
	     )
	     lst
	   )
    )
    (setq basept (list (nth 1 (nth 0 lst))
		   (nth 2 (nth 0 lst))
		   (nth 3 (nth 0 lst))
	     )
    )
    (setq blk (cdr (nentselp basept)))
    (setq m (nth 1 blk))
    (setq xdir	 (list (car (car m)) (car (cadr m)) (car (caddr m)))
	  refpt	 (mapcar '+ basept xdir)
    )
    (command "_rotate3d" basept "" "2" basept refpt 90.0)
  )
  (setvar "osmode" osm)
  (princ)
)


(defun c:rot90ang (/ sel idx lst obj m xdir basept blk refpt)
; rotates blocks by 90° about their x axis projected to the WCS xy plane.  
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq sel (ssget "_:L" '((0 . "INSERT"))))
  (repeat (setq idx (sslength sel))
    (setq lst
	   (cons
	     (cons (setq
		     obj
		      (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
		   )
		   (vlax-get obj 'insertionpoint)
	     )
	     lst
	   )
    )
    (setq basept (list (nth 1 (nth 0 lst))
		   (nth 2 (nth 0 lst))
		   (nth 3 (nth 0 lst))
	     )
    )
    (setq blk (cdr (nentselp basept)))
    (setq m (nth 1 blk))
    (setq xdir	 (list (car (car m)) (car (cadr m)) (car (caddr m)))
	  refpt	 (mapcar '+ basept xdir)
          refpt  (list (nth 0 refpt) (nth 1 refpt) (nth 2 basept))
    )
    (command "_rotate3d" basept "" "2" basept refpt 90.0)
  )
  (setvar "osmode" osm)
  (princ)
)

 

rotate multiple blocks in 3D.lsp

[SEANT]

For what it's worth, here is one way it could be done with VBA:

 

 Option Explicit
 
 Public Sub StandUp()
   Dim entSelected As AcadEntity
   Dim vPt As Variant
   Dim dblRotAng As Double
   Dim blkRef As AcadBlockReference
   Dim varInsPt As Variant
   Dim dblNewNorm(0 To 2) As Double
   Dim varNewInsPt As Variant
   
   Dim intCode(0) As Integer
   Dim varData(0) As Variant

   With ThisDrawing
      intCode(0) = 0: varData(0) = "INSERT"
      If SoSSS(intCode, varData) > 0 Then
      
      For Each entSelected In .SelectionSets.Item("TempSSet")
         Set blkRef = entSelected
         If blkRef.EffectiveName = "Fence" Then
           varInsPt = blkRef.InsertionPoint
           dblRotAng = blkRef.Rotation
           dblNewNorm(0) = Sin(dblRotAng): dblNewNorm(1) = -Cos(dblRotAng): dblNewNorm(2) = 0
           blkRef.Rotation = 0#
           blkRef.Normal = dblNewNorm
   
           varNewInsPt = .Utility.TranslateCoordinates(varInsPt, acWorld, acOCS, 0, dblNewNorm)
           varNewInsPt = .Utility.TranslateCoordinates(varNewInsPt, acOCS, acWorld, 0, dblNewNorm)
           blkRef.InsertionPoint = varNewInsPt
         End If
         Next
       End If
   End With
End Sub

Private Sub SSClear()
Dim SSS As AcadSelectionSets
   On Error Resume Next
   Set SSS = ThisDrawing.SelectionSets
      If SSS.Count > 0 Then
         SSS.Item("TempSSet").Delete
      End If
End Sub

Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
   Dim TempObjSS As AcadSelectionSet
   SSClear
   Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
         'pick selection set
   If IsMissing(grpCode) Then
      TempObjSS.SelectOnScreen
   Else
      TempObjSS.SelectOnScreen grpCode, dataVal
   End If
   SoSSS = TempObjSS.Count
End Function