(defun C:123 (/ eset
MULTILEADER_ERM_L80n MULTILEADER_ERM_L90n
MULTILEADER_ERM_L140A
) ;define a program name
(vl-load-com)
(or drawing_scale (setq drawing_scale "60")) ; set global variables
(if
(/= ""
(setq
strdia (getstring
(strcat "\nEnter Drawing Scale <" drawing_scale "> ")
)
)
)
(setq drawing_scale strdia)
)
(princ "\nEnter Drawing Scale is ")
(princ drawing_scale)
(princ)
(if (setq eset (ssget)) ;use the ssget function to select entities
(progn ;use progn since there will be more than 1 statement
(setq cntr 0) ;set the cntr to the first item in the set
(setq MTexT_Set (ssadd))
(setq MULTILEADER_Set (ssadd))
(setq INSERT_Set (ssadd))
(setq TEXT_Set (ssadd))
(setq MULTILEADER_ERM_L80n (ssadd))
(setq MULTILEADER_ERM_L90n (ssadd))
(setq MULTILEADER_ERM_L110 (ssadd))
(setq MULTILEADER_ERM_L140A (ssadd))
(setq MTexT_ERM_L80n (ssadd))
(setq MTexT_ERM_L90n (ssadd))
(setq MTexT_ERM_L100 (ssadd))
(setq MTexT_ERM_L110 (ssadd))
(setq MTexT_ERM_L120n (ssadd))
(setq MTexT_ERM_L140A (ssadd))
(setq MTexT_ERM_L160A (ssadd))
(setq Station_Entrance_Block (ssadd))
(setq Pedistrain_Bridge_Entrance_Block (ssadd))
(setq ETSphone_number (ssadd))
(setq all_blocks (ssadd))
(setq Fire_Zone_pline_Block (ssadd))
(while (< cntr (sslength eset)) ;while cntr is less than the length of the set
;;; Note: the length is one more than the index of items since the first item is zero. In other words, to
;;; get to the first item in a selection set consisting of one item you would use (ssname eset 0) not
;;; (ssname eset 1).
(setq en (ssname eset cntr)) ;get the entity name of the item indexed with cntr
(setq enlist (entget en)) ;get the dxf group codes of the enitity
(setq entity_name (cdr (assoc 0 enlist))) ;get the layer name
;;; (princ "\n ") ;print "\n " will cause a new line to be printed
;;; (princ entity_name) ;print the layer name to the command line
(cond
((= entity_name "MTEXT")
(progn
(setq
style (cdr (assoc 7 (entget en)))
)
(cond
((or (= "ERM L80n" style) (= "ERM L80" style))
(setq MTexT_ERM_L80n
(ssadd en MTexT_ERM_L80n)
)
)
((= "ERM L90n" style)
(setq MTexT_ERM_L90n
(ssadd en MTexT_ERM_L90n)
)
)
((or (= "ERM L100" style) (= "ERM L100n" style))
(setq MTexT_ERM_L100
(ssadd en MTexT_ERM_L100)
)
)
((= "ERM L110" style)
(setq MTexT_ERM_L110
(ssadd en MTexT_ERM_L110)
)
)
((= "ERM L120n" style)
(setq MTexT_ERM_L120n
(ssadd en MTexT_ERM_L120n)
)
)
((= "ERM L140A" style)
(setq MTexT_L140A
(ssadd en MTexT_L140A)
)
)
((= "ERM L160 A" style)
(setq MTexT_ERM_L160A
(ssadd en MTexT_ERM_L160A)
)
)
)
)
)
;;; ((= entity_name "LWPOLYLINE") (ssadd entity_name MTexT_Set))
((= entity_name "MULTILEADER")
(progn
(setq
style (cdr (assoc 2 (entget (cdr (assoc 340 enlist)))))
)
(cond
((= "ERM L80n" style)
(setq MULTILEADER_ERM_L80n
(ssadd en MULTILEADER_ERM_L80n)
)
)
((= "ERM L90n" style)
(setq MULTILEADER_ERM_L90n
(ssadd en MULTILEADER_ERM_L90n)
)
)
((= "ERM L110" style)
(setq MULTILEADER_ERM_L110
(ssadd en MULTILEADER_ERM_L110)
)
)
((= "ERM L140A" style)
(setq MULTILEADER_ERM_L140A
(ssadd en MULTILEADER_ERM_L140A)
)
)
((= "ERM L160A" style)
(setq MTexT_ERM_L160A
(ssadd en MTexT_ERM_L160A)
)
)
)
)
)
;;; -------------------------------------------------------------
((= entity_name "INSERT")
(progn
(setq
style (cdr (assoc 2 (entget en)))
)
(cond
((= "Arrow-Sta-Ent" style)
(setq Station_Entrance_Block
(ssadd en Station_Entrance_Block)
)
)
((= "Arrow-Adj-Sta" style)
(setq Pedistrain_Bridge_Entrance_Block
(ssadd en Pedistrain_Bridge_Entrance_Block)
)
)
((or (= "ETSphone#" style)
(= "windscreen1" style)
(= "Elev-Sta" style)
)
(setq ETSphone_number
(ssadd en ETSphone_number)
)
)
((= entity_name "INSERT")
(setq all_blocks
(ssadd en all_blocks)
)
)
)
)
;;; --------------------------------------------
)
((= entity_name "TEXT") (ssadd en TEXT_Set))
((= entity_name "LWPOLYLINE")
(progn
(setq
layer_name
(cdr (assoc 8 (entget en)))
)
(cond
((= "VJ-FIRE-ZONE" layer_name)
(setq Fire_Zone_pline_Block
(ssadd en Fire_Zone_pline_Block)
)
)
)
)
)
)
(setq cntr (+ cntr 1)) ;increment the counter
) ;close the while statement
) ;close the progn on the if statement
(princ "\n Error - No entities selected.")
;print a message on the else statement
; note: the if statement can be a " if then " statement or a " if then else" statement
) ;close the if statement
(setq a (sslength MULTILEADER_ERM_L80n))
(princ (strcat (rtos (sslength MULTILEADER_ERM_L80n) 2 0)
" MULTILEADER_ERM_L80n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L90n) 2 0)
" MULTILEADER_ERM_L90n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L110) 2 0)
" MULTILEADER_ERM_L110 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L140A) 2 0)
" MULTILEADER_ERM_L140A entities selected.\n"
)
)
;;;Mtext out put
(princ (strcat (rtos (sslength MTexT_ERM_L80n) 2 0)
" MTexT_ERM_L80n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L90n) 2 0)
" MTexT_ERM_L90n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L100) 2 0)
" MTexT_ERM_L100 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L110) 2 0)
" MTexT_ERM_L110 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L120n) 2 0)
" MTexT_ERM_L120n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L140A) 2 0)
" MTexT_ERM_L140A entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L160A) 2 0)
" MTexT_ERM_L160A entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Pedistrain_Bridge_Entrance_Block) 2 0)
" Pedistrain_Bridge_Entrance_Block entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Station_Entrance_Block) 2 0)
" Station_Entrance_Block entities selected.\n"
)
)
(princ
(strcat (rtos (sslength ETSphone_number) 2 0)
" ETSphone_number entities selected.\n"
)
)
(princ
(strcat (rtos (sslength all_blocks) 2 0)
" Other blocks entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Fire_Zone_pline_Block) 2 0)
" Fire_Zone_pline_ entities selected.\n"
)
)
(cond
((< 0 (sslength MULTILEADER_ERM_L80n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L80n
0
)
)
)
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L80n))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L90n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L90n
0
)
)
)
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L90n))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L110))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L110
0
)
)
)
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L110))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L140A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L140A
0
)
)
)
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L140A))
)
)
)
)
)
;;; ---Mtext height---
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MTexT_ERM_L80n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L80n
0
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L80n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L80n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L80n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L90n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L90n
0
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L90n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L90n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L90n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L100))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L100
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L100)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L100 i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L100
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L110))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L110
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L110)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L110 i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L110
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L120n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L120n
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L120n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L120n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L120n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L140A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L140A
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L140A)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L140A i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L140A
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L160A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L160A
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L160A)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L160A i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L160A
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength Station_Entrance_Block))
(progn
(setq calculated_block_scale
(rtos
(*
94.5
(/ (atof drawing_scale)
60
)
)
2
2
)
)
(setq i 0
n (sslength Station_Entrance_Block)
)
(while (< i n)
(setq e (ssname Station_Entrance_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 1))
(setq ed (entget (ssname
Station_Entrance_Block
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
;;;This will affect the arrow showing station so i will return it back to normal;
;;; for pedistrian it should be 60
(cond
((< 0 (sslength Pedistrain_Bridge_Entrance_Block))
(progn
(setq calculated_block_scale
(rtos
(*
60
(/ (atof drawing_scale)
60
)
)
2
2
)
)
(setq i 0
n (sslength Pedistrain_Bridge_Entrance_Block)
)
(while (< i n)
(setq e (ssname Pedistrain_Bridge_Entrance_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 (atof calculated_block_scale)))
(setq ed (entget (ssname
Pedistrain_Bridge_Entrance_Block
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale 1 ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength all_blocks))
(progn
(setq calculated_block_scale
drawing_scale
)
(setq i 0
n (sslength all_blocks)
)
(while (< i n)
(setq e (ssname all_blocks i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 1))
(setq ed (entget (ssname
all_blocks
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength ETSphone_number))
(princ
"\nPlease manualy adjust phone number or Windscreen scales "
)
)
)
(cond
((< 0 (sslength Fire_Zone_pline_Block))
(progn
(setq calculated_width
(rtos
(*
0.03
(atof drawing_scale)
)
2
2
)
)
(setq i 0
n (sslength Fire_Zone_pline_Block)
)
(while (< i n)
(setq e (ssname Fire_Zone_pline_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 43 (atof calculated_width)))
;;; (setq y_scale (cons 42 (atof calculated_width)))
;;; (setq z_scale (cons 43 1))
(setq ed (entget (ssname
Fire_Zone_pline_Block
i
)
)
)
(setq ed (subst x_scale (assoc 43 ed) ed))
;;; (setq ed (subst y_scale (assoc 42 ed) ed))
;;; (setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
) ;close the program
MULTILEADER_ERM_L80n MULTILEADER_ERM_L90n
MULTILEADER_ERM_L140A
) ;define a program name
(vl-load-com)
(or drawing_scale (setq drawing_scale "60")) ; set global variables
(if
(/= ""
(setq
strdia (getstring
(strcat "\nEnter Drawing Scale <" drawing_scale "> ")
)
)
)
(setq drawing_scale strdia)
)
(princ "\nEnter Drawing Scale is ")
(princ drawing_scale)
(princ)
(if (setq eset (ssget)) ;use the ssget function to select entities
(progn ;use progn since there will be more than 1 statement
(setq cntr 0) ;set the cntr to the first item in the set
(setq MTexT_Set (ssadd))
(setq MULTILEADER_Set (ssadd))
(setq INSERT_Set (ssadd))
(setq TEXT_Set (ssadd))
(setq MULTILEADER_ERM_L80n (ssadd))
(setq MULTILEADER_ERM_L90n (ssadd))
(setq MULTILEADER_ERM_L110 (ssadd))
(setq MULTILEADER_ERM_L140A (ssadd))
(setq MTexT_ERM_L80n (ssadd))
(setq MTexT_ERM_L90n (ssadd))
(setq MTexT_ERM_L100 (ssadd))
(setq MTexT_ERM_L110 (ssadd))
(setq MTexT_ERM_L120n (ssadd))
(setq MTexT_ERM_L140A (ssadd))
(setq MTexT_ERM_L160A (ssadd))
(setq Station_Entrance_Block (ssadd))
(setq Pedistrain_Bridge_Entrance_Block (ssadd))
(setq ETSphone_number (ssadd))
(setq all_blocks (ssadd))
(setq Fire_Zone_pline_Block (ssadd))
(while (< cntr (sslength eset)) ;while cntr is less than the length of the set
;;; Note: the length is one more than the index of items since the first item is zero. In other words, to
;;; get to the first item in a selection set consisting of one item you would use (ssname eset 0) not
;;; (ssname eset 1).
(setq en (ssname eset cntr)) ;get the entity name of the item indexed with cntr
(setq enlist (entget en)) ;get the dxf group codes of the enitity
(setq entity_name (cdr (assoc 0 enlist))) ;get the layer name
;;; (princ "\n ") ;print "\n " will cause a new line to be printed
;;; (princ entity_name) ;print the layer name to the command line
(cond
((= entity_name "MTEXT")
(progn
(setq
style (cdr (assoc 7 (entget en)))
)
(cond
((or (= "ERM L80n" style) (= "ERM L80" style))
(setq MTexT_ERM_L80n
(ssadd en MTexT_ERM_L80n)
)
)
((= "ERM L90n" style)
(setq MTexT_ERM_L90n
(ssadd en MTexT_ERM_L90n)
)
)
((or (= "ERM L100" style) (= "ERM L100n" style))
(setq MTexT_ERM_L100
(ssadd en MTexT_ERM_L100)
)
)
((= "ERM L110" style)
(setq MTexT_ERM_L110
(ssadd en MTexT_ERM_L110)
)
)
((= "ERM L120n" style)
(setq MTexT_ERM_L120n
(ssadd en MTexT_ERM_L120n)
)
)
((= "ERM L140A" style)
(setq MTexT_L140A
(ssadd en MTexT_L140A)
)
)
((= "ERM L160 A" style)
(setq MTexT_ERM_L160A
(ssadd en MTexT_ERM_L160A)
)
)
)
)
)
;;; ((= entity_name "LWPOLYLINE") (ssadd entity_name MTexT_Set))
((= entity_name "MULTILEADER")
(progn
(setq
style (cdr (assoc 2 (entget (cdr (assoc 340 enlist)))))
)
(cond
((= "ERM L80n" style)
(setq MULTILEADER_ERM_L80n
(ssadd en MULTILEADER_ERM_L80n)
)
)
((= "ERM L90n" style)
(setq MULTILEADER_ERM_L90n
(ssadd en MULTILEADER_ERM_L90n)
)
)
((= "ERM L110" style)
(setq MULTILEADER_ERM_L110
(ssadd en MULTILEADER_ERM_L110)
)
)
((= "ERM L140A" style)
(setq MULTILEADER_ERM_L140A
(ssadd en MULTILEADER_ERM_L140A)
)
)
((= "ERM L160A" style)
(setq MTexT_ERM_L160A
(ssadd en MTexT_ERM_L160A)
)
)
)
)
)
;;; -------------------------------------------------------------
((= entity_name "INSERT")
(progn
(setq
style (cdr (assoc 2 (entget en)))
)
(cond
((= "Arrow-Sta-Ent" style)
(setq Station_Entrance_Block
(ssadd en Station_Entrance_Block)
)
)
((= "Arrow-Adj-Sta" style)
(setq Pedistrain_Bridge_Entrance_Block
(ssadd en Pedistrain_Bridge_Entrance_Block)
)
)
((or (= "ETSphone#" style)
(= "windscreen1" style)
(= "Elev-Sta" style)
)
(setq ETSphone_number
(ssadd en ETSphone_number)
)
)
((= entity_name "INSERT")
(setq all_blocks
(ssadd en all_blocks)
)
)
)
)
;;; --------------------------------------------
)
((= entity_name "TEXT") (ssadd en TEXT_Set))
((= entity_name "LWPOLYLINE")
(progn
(setq
layer_name
(cdr (assoc 8 (entget en)))
)
(cond
((= "VJ-FIRE-ZONE" layer_name)
(setq Fire_Zone_pline_Block
(ssadd en Fire_Zone_pline_Block)
)
)
)
)
)
)
(setq cntr (+ cntr 1)) ;increment the counter
) ;close the while statement
) ;close the progn on the if statement
(princ "\n Error - No entities selected.")
;print a message on the else statement
; note: the if statement can be a " if then " statement or a " if then else" statement
) ;close the if statement
(setq a (sslength MULTILEADER_ERM_L80n))
(princ (strcat (rtos (sslength MULTILEADER_ERM_L80n) 2 0)
" MULTILEADER_ERM_L80n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L90n) 2 0)
" MULTILEADER_ERM_L90n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L110) 2 0)
" MULTILEADER_ERM_L110 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MULTILEADER_ERM_L140A) 2 0)
" MULTILEADER_ERM_L140A entities selected.\n"
)
)
;;;Mtext out put
(princ (strcat (rtos (sslength MTexT_ERM_L80n) 2 0)
" MTexT_ERM_L80n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L90n) 2 0)
" MTexT_ERM_L90n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L100) 2 0)
" MTexT_ERM_L100 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L110) 2 0)
" MTexT_ERM_L110 entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L120n) 2 0)
" MTexT_ERM_L120n entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L140A) 2 0)
" MTexT_ERM_L140A entities selected.\n"
)
)
(princ (strcat (rtos (sslength MTexT_ERM_L160A) 2 0)
" MTexT_ERM_L160A entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Pedistrain_Bridge_Entrance_Block) 2 0)
" Pedistrain_Bridge_Entrance_Block entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Station_Entrance_Block) 2 0)
" Station_Entrance_Block entities selected.\n"
)
)
(princ
(strcat (rtos (sslength ETSphone_number) 2 0)
" ETSphone_number entities selected.\n"
)
)
(princ
(strcat (rtos (sslength all_blocks) 2 0)
" Other blocks entities selected.\n"
)
)
(princ
(strcat (rtos (sslength Fire_Zone_pline_Block) 2 0)
" Fire_Zone_pline_ entities selected.\n"
)
)
(cond
((< 0 (sslength MULTILEADER_ERM_L80n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L80n
0
)
)
)
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L80n))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L90n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L90n
0
)
)
)
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L90n))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L110))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L110
0
)
)
)
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L110))
)
)
)
)
)
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MULTILEADER_ERM_L140A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr
(assoc
2
(entget
(cdr (assoc
340
(entget
(ssname
MULTILEADER_ERM_L140A
0
)
)
)
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(mapcar
(function
(lambda (x)
(vla-put-TextHeight x (atof calculated_text))
)
)
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex MULTILEADER_ERM_L140A))
)
)
)
)
)
;;; ---Mtext height---
;;;------------------------------------------------------------------------------------------------------------------------
(cond
((< 0 (sslength MTexT_ERM_L80n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L80n
0
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L80n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L80n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L80n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L90n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L90n
0
)
)
)
)
6
2
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L90n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L90n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L90n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L100))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L100
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L100)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L100 i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L100
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L110))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L110
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L110)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L110 i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L110
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L120n))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L120n
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L120n)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L120n i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L120n
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L140A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L140A
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L140A)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L140A i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L140A
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength MTexT_ERM_L160A))
(progn
(setq calculated_text
(rtos
(*
(atof drawing_scale)
(/ (atof
(substr
(cdr (assoc
7
(entget
(ssname
MTexT_ERM_L160A
0
)
)
)
)
6
3
)
)
1000
)
)
2
2
)
)
(setq i 0
n (sslength MTexT_ERM_L160A)
)
(while (< i n)
(setq e (ssname MTexT_ERM_L160A i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq SZ (cons 40 (atof calculated_text)))
(setq ed (entget (ssname
MTexT_ERM_L160A
i
)
)
)
(setq ed (subst SZ (assoc 40 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength Station_Entrance_Block))
(progn
(setq calculated_block_scale
(rtos
(*
94.5
(/ (atof drawing_scale)
60
)
)
2
2
)
)
(setq i 0
n (sslength Station_Entrance_Block)
)
(while (< i n)
(setq e (ssname Station_Entrance_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 1))
(setq ed (entget (ssname
Station_Entrance_Block
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
;;;This will affect the arrow showing station so i will return it back to normal;
;;; for pedistrian it should be 60
(cond
((< 0 (sslength Pedistrain_Bridge_Entrance_Block))
(progn
(setq calculated_block_scale
(rtos
(*
60
(/ (atof drawing_scale)
60
)
)
2
2
)
)
(setq i 0
n (sslength Pedistrain_Bridge_Entrance_Block)
)
(while (< i n)
(setq e (ssname Pedistrain_Bridge_Entrance_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 (atof calculated_block_scale)))
(setq ed (entget (ssname
Pedistrain_Bridge_Entrance_Block
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale 1 ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength all_blocks))
(progn
(setq calculated_block_scale
drawing_scale
)
(setq i 0
n (sslength all_blocks)
)
(while (< i n)
(setq e (ssname all_blocks i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 41 (atof calculated_block_scale)))
(setq y_scale (cons 42 (atof calculated_block_scale)))
(setq z_scale (cons 43 1))
(setq ed (entget (ssname
all_blocks
i
)
)
)
(setq ed (subst x_scale (assoc 41 ed) ed))
(setq ed (subst y_scale (assoc 42 ed) ed))
(setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
(cond
((< 0 (sslength ETSphone_number))
(princ
"\nPlease manualy adjust phone number or Windscreen scales "
)
)
)
(cond
((< 0 (sslength Fire_Zone_pline_Block))
(progn
(setq calculated_width
(rtos
(*
0.03
(atof drawing_scale)
)
2
2
)
)
(setq i 0
n (sslength Fire_Zone_pline_Block)
)
(while (< i n)
(setq e (ssname Fire_Zone_pline_Block i)
x (cdr (assoc 0 (entget e)))
)
(progn
(setq x_scale (cons 43 (atof calculated_width)))
;;; (setq y_scale (cons 42 (atof calculated_width)))
;;; (setq z_scale (cons 43 1))
(setq ed (entget (ssname
Fire_Zone_pline_Block
i
)
)
)
(setq ed (subst x_scale (assoc 43 ed) ed))
;;; (setq ed (subst y_scale (assoc 42 ed) ed))
;;; (setq ed (subst z_scale (assoc 43 ed) ed))
(entmod ed)
(princ)
)
(setq i (1+ i))
)
)
)
)
) ;close the program
No comments:
Post a Comment