LISP to give dimensions between two different objects

[Amriya_Exe]

This is one girder/span I have to make 100+ with different lengths (same structure)

I will add objects as block via coordinates but after that I want to give dimensions like showing in Image below

please give some recommendation/idea/lisp to complete this work smoothly.

*AS sample I showing it horizontal but in actual it will be placed on alignment on various angles. 

*Dim style will be same

[Sea-Haven]

Made a start did 2 rows of dims. Give it a try, ran out of time.

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-give-dimensions-between-two-different-objects/td-p/12876789
; Drawing 1 
; By AlanH July 2024
; 1st stage 

(defun c:dimb ( / getm ss up ptcnr lst obj pt1 pt2 ptside dist txt)


(prompt "select the blocks semistart semiend and fullcir use window")
(setq ss (ssget (list (cons 0  "INSERT"))))

(setq oldsnap (getvar 'osmode))
(setq oldlay (getvar 'clayer))


(setq ptcnr (getpoint "\nPick top left or bottom left "))
(setvar 'osmode 0)

(initget 1 "Up Down")
(setq up (getkword "\nUp or Down "))


(if (= ss nil)
(progn (Alert "No blocks found will exit now check dwg ")(exit))
)

(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq bname (vlax-get obj 'Effectivename))
(if (or (= bname "semistart")(= bname "semiend")(= bname "fullcir"))
 (setq lst (cons (vlax-get obj 'insertionpoint) lst))
)
)
(setq lst (vl-sort lst '(lambda (x y) (< (car x)(car y)))))

(setq inc 0.13)

; row 1

(setvar 'clayer "dp-slab")

(if (= up "Up")
  (setq ptside (mapcar '+ (car lst) (list 0.0 3.0 0.0)))
  (setq ptside (mapcar '+ (car lst) (list 0.0 -3.0 0.0)))
)

(setq pt1 (mapcar '+ (car lst) (list (- inc) 0.0 0.0)))
(setq x 1)

(repeat (- (length lst) 2)
(setq pt2 (nth x lst))
(setq len (distance pt1 pt2))
(cond 
   ((<= len 3.0)(setq txt (strcat "<>"  " \n3mSLAB")))
   ((<= len 4.0)(setq txt (strcat "<>"  " \n4mSLAB")))
   ((<= len 5.0)(setq txt (strcat "<>"  " \n5mSLAB")))
   ((<= len 6.0)(setq txt (strcat "<>"  " \n6mSLAB")))
)
(command "dim" "hor" pt1 pt2 "T" txt ptside "exit")
(setq x (1+ x))
(setq pt1 pt2)
)
(setq pt2 (mapcar '+ (last lst) (list inc 0.0 0.0)))
(command "dim" "hor" pt1 pt2 "T" txt ptside "exit")

; dim row 2 to be done 4 off

(setq pt1 (mapcar '+ (car lst) (list (- inc) 0.0 0.0)))
(setq x 2)

(if (= up "Up")
  (setq ptside (mapcar '+ (car lst) (list 0.0 4.0 0.0)))
  (setq ptside (mapcar '+ (car lst) (list 0.0 -4.0 0.0)))
)
(setq alpha 65)
(repeat (/ (- (length lst) 1) 2)
(setq pt2 (nth x lst))
(setq dist (distance pt1 pt2))
(setq txt (strcat (chr alpha) " Block " "<>"))
(command "dim" "hor" pt1 pt2 "T" txt ptside "exit")
(setq pt1 pt2)
(setq x (+ x 2))
(setq alpha (+ 1 alpha))
)

; dim row 3

(setq pt1 (mapcar '+ (car lst) (list (- inc) 0.0 0.0)))
(setq pt2 (mapcar '+ (last lst) (list inc 0.0 0.0)))

(if (= up "Up")
(setq ptside (mapcar '+ pt1 (list 0.0 5.0 0.0)))
(setq ptside (mapcar '+ pt1 (list 0.0 -5.0 0.0)))
)
(command "dim" "hor" pt1 pt2 ptside "" "exit")

(setvar 'clayer oldlay)
(setvar 'osmode oldsnap)

(princ)
)
(c:dimb)

[Amriya_Exe]

Your results looks perfect.
I tried command DIMB its asked to select object I selecting all Anchors using Window.
- next selecting Top left or bottom left
- Ask for Down/Up

But not getting completed please check video 

[Sea-Haven]

Did it show any error messages ? Please post. 

You are right just window select the beam as it looks for blocks and finds the correct ones.

When asked to pick top left pick the point as per image, it uses this as a reference point for dim offset.

I have only done 2 of the dims there are like 4 or 5 required. Maybe tomorrow will do some more ran out of time today.

[Amriya_Exe]

dimb.lsp successfully loaded.
Command: select the blocks semistart semiend and fullcir use window
Select objects: Specify opposite corner: 0 found
Select objects: Specify opposite corner: 17 found
Select objects:
Pick top left or bottom left
Up or Down up
dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
5mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
5mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
5mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
5mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
4mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
4mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
4mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Non-associative dimension created.
Specify dimension line location or [Mtext/Text/Angle]:
Dim: <>
4mSLAB
Dim: exit
Command: dim
Dim: hor
Specify first extension line origin or <select object>:
Specify second extension line origin:
Specify dimension line location or [Mtext/Text/Angle]:
Enter dimension text <35878.70>:
Dim: exit


There is no any error but output not coming like yours Only one full length 35878.70 is getting marked.

[Sea-Haven]

I have updated code I was going around in circles not sure if it was my Bricscad causing a problem but it was working with dim text as "<> SLAB" and now <> is not accepted but found a work around.

Note you need to remove the suffix from your dimension style as I write 2 lines for the dimension. 

I have updated code above to where I am at I need to add the 10mm offsets to the A B C slabs etc.

[rolisonfelipe]

THIS LISP HAS A LOT OF POTENTIAL

[Amriya_Exe]

Thank you for update.

Here is result 

UP getting partially 

Down Working Fine But need some fix

- 4mSLAB & 5mSLAB both Coming Need only 4mSLAB (Or we can define Dimstyle "dp-Slab")

For Block Length Define Dimstyle "dp-Block")

I will add 4mSlab and 5mSLAB manually later

-For Full length "DP-Viaduct)

How we will do for this 

[Amriya_Exe]

Agree.

[Sea-Haven]

Need to add the 10mm dims and the 31.0 dims, matching actual distance.

Make sure it works for Up and Down etc.

Lastly it is in the To do list.

[Amriya_Exe]

no problem
can wait till you complete

[Sea-Haven]

Updated code above does the 1st 3 Dims Up or Down. Please try. Been busy but will try to add some more dims. Note remove the Suffix from Dim style.