Scale drawing

(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

Match Text

(defun c:mt  (/ cEnt mEnt)
  (if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
           (member (cdr (assoc 0 (entget cEnt)))
                   '("TEXT" "MTEXT" "ATTRIB")))
    (progn
      (redraw cEnt 3)
      (while (and (setq mEnt (car (nentsel "\nSelect Destination Text: ")))
                  (member (cdr (assoc 0 (entget mEnt)))
                          '("TEXT" "MTEXT" "ATTRIB")))
        (entmod (subst (assoc 1 (entget cEnt))
                       (assoc 1 (entget mEnt))
                       (entget mEnt))))
      (redraw cEnt 4))
    (princ "\n<!> Incorrect Selection <!>"))
  (princ))



(defun c:mt2  (/ cEnt mEnt sLst)
  (if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
           (member (cdr (assoc 0 (entget cEnt)))
                   '("TEXT" "MTEXT" "ATTRIB")))
    (progn
      (redraw cEnt 3)
      (if (setq ss (ssget "_X" '((-4 . "<NOT") (0 . "TEXT,MTEXT,INSERT") (-4 . "NOT>"))))
        (mapcar '(lambda (x) (redraw x 2)) (setq sLst (mapcar 'cadr (ssnamex ss)))))
      (while (and (setq mEnt (car (nentsel "\nSelect Destination Text: ")))
                  (member (cdr (assoc 0 (entget mEnt)))
                          '("TEXT" "MTEXT" "ATTRIB")))
        (entmod (subst (assoc 1 (entget cEnt))
                       (assoc 1 (entget mEnt))
                       (entget mEnt)))))
    (princ "\n<!> Incorrect Selection <!>"))
  (command "_regenall")
  (princ))



(defun c:mt3  (/ cEnt ss)
  (vl-load-com)
  (if (and (setq cEnt (car (nentsel "\nSelect Source Text: ")))
           (member (cdr (assoc 0 (entget cEnt)))
                   '("TEXT" "MTEXT" "ATTRIB")))
    (progn
      (redraw cEnt 3)
      (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
        (foreach x  (vl-remove-if 'listp
                      (mapcar 'cadr (ssnamex ss)))
          (entmod (subst (assoc 1 (entget cEnt))
                         (assoc 1 (entget x))
                         (entget x))))))
    (princ "\n<!> Incorrect Selection <!>"))
  (command "_regenall")
  (princ))

PDF problem when you combine it

In Auto cad Go to file plot
1. select your printer PDF or DWG To PDF .pc3
2. Click properties then select custom properties in Device and Document Settings Tab
3. Click Custom Properties..
4.Under Font Handling select Capture all
5. click ok to close all the dialog boxes.
That is it. This will fix all the problems related to embedding fonts.

if you go to Adobe Acrobat pro in file->properties under Font tab you will see ArialMT(Embedded). this will not say embedded if you do not do the above steps.

Type of weed. To remove vertec

http://forums.autodesk.com/t5/AutoCAD-Civil-3D-General/Quickest-way-to-remove-vertices-from-polyline/td-p/3308333
;;;  PLDIET.lsp [command name: PLD]
;;;  To put lightweight PolyLines on a DIET (remove excess vertices); usually
;;;    used for contours with too many too-closely-spaced vertices.
;;;  Concept from PVD routine [posted on AutoCAD Customization Discussion
;;;    Group by oompa_l, July 2009] by Brian Hailey, added to by CAB, and
;;;    WEED and WEED2 routines by Skyler Mills at Cadalyst CAD Tips [older
;;;    routines for "heavy" Polylines that won't work on newer lightweight ones];
;;;    simplified in entity data list processing, and enhanced in other ways [error
;;;    handling, default values, join collinear segments beyond max. distance,
;;;    limit to current space/tab, account for change in direction across 0 degrees,
;;;    option to keep or eliminate arc segments] by Kent Cooper, August 2009.
;
(defun C:PLD
  (/ *error* cmde disttemp cidtemp arctemp plinc plsel pldata
  ucschanged front 10to42 vinc verts vert1 vert2 vert3)
;
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort"))
      (princ (strcat "\nError: " errmsg))
    ); end if
    (if ucschanged (command "_.ucs" "_prev"))
      ; ^ i.e. don't go back unless routine reached UCS change but didn't change back
    (command "_.undo" "_end")
    (setvar 'cmdecho cmde)
  ); end defun - *error*
;
  (setq cmde (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "_.undo" "_begin")
  (setq
    disttemp
      (getdist
        (strcat
          "\nMaximum distance between non-collinear vertices to straighten"
          (if *distmax* (strcat " <" (rtos *distmax* 2 2) ">") ""); default only if not first use
          ": "
        ); end strcat
      ); end getdist & disttemp
    *distmax*
      (cond
        (disttemp); user entered number or picked distance
        (T *distmax*); otherwise, user hit Enter - keep value
      ); end cond & *distmax*
    cidtemp
      (getangle
        (strcat
          "\nMaximum change in direction to straighten"
          (strcat ; offer prior choice if not first use; otherwise 15 degrees
            " <"
            (if *cidmax* (angtos *cidmax*) (angtos (/ pi 12)))
            ">"
          ); end strcat
          ": "
        ); end strcat
      ); end getdist & cidtemp
    *cidmax*
      (cond
        (cidtemp); user entered number or picked angle
        (*cidmax*); Enter with prior value set - use that
        (T (/ pi 12)); otherwise [Enter on first use] - 15 degrees
      ); end cond & *cidmax*
    plinc 0 ; incrementer through selection set of Polylines
  ); end setq
  (initget "Retain Straighten")
  (setq
    arctemp
      (getkword
        (strcat
          "\nRetain or Straighten arc segments [R/S] <"
          (if *arcstr* (substr *arcstr* 1 1) "S"); at first use, S default; otherwise, prior choice
          ">: "
        ); end strcat
      ); end getkword
    *arcstr*
      (cond
        (arctemp); if User typed something, use it
        (*arcstr*); if Enter and there's a prior choice, keep that
        (T "Straighten"); otherwise [Enter on first use], Straighten
      ); end cond & *arcstr*
  ); end setq
;
  (prompt "\nSelect LWPolylines to put on a diet, or press Enter to select all: ")
  (cond
    ((setq plsel (ssget '((0 . "LWPOLYLINE"))))); user-selected Polylines
    ((setq plsel (ssget "X" (list '(0 . "LWPOLYLINE") (cons 410 (getvar 'ctab))))))
      ; all Polylines [in current space/tab only]
  ); end cond
;
  (repeat (sslength plsel)
    (setq pldata (entget (ssname plsel plinc)))
    (if (/= (cdr (last pldata)) (trans '(0 0 1) 1 0)); extr. direction not parallel current CS
        ; for correct angle & distance calculations [projected onto current construction
        ; plane], since 10-code entries for LWPolylines are only 2D points:
      (progn
        (command "_.ucs" "_new" "_object" (ssname plsel plinc)) ; set UCS to match object
        (setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't
      ); end progn
    ); end if
    (setq
      front ; list of "front end" [pre-vertices] entries, minus entity names & handle
        (vl-remove-if
          '(lambda (x)
            (member (car x) '(-1 330 5 10 40 41 42 210))
          ); end lambda
          pldata
        ); end removal & front
      10to42 ; list of all code 10, 40, 41, 42 entries only
        (vl-remove-if-not
          '(lambda (x)
            (member (car x) '(10 40 41 42))
          ); end lambda
          pldata
        ); end removal & 10to42
      vinc (/ (length 10to42) 4); incrementer for vertices within each Polyline
      verts nil ; eliminate from previous Polyline [if any]
    ); end setq
    (if (= *arcstr* "Straighten")
      (progn
        (setq bulges ; find any bulge factors
          (vl-remove-if-not
            '(lambda (x)
              (and
                (= (car x) 42)
                (/= (cdr x) 0.0)
              ); end and
            ); end lambda
            10to42
          ); end removal & bulges
        ); end setq
        (foreach x bulges (setq 10to42 (subst '(42 . 0.0) x 10to42)))
          ; straighten all arc segments to line segments
      ); end progn
    ); end if
    (repeat vinc
      (setq
        verts ; sub-group list: separate list of four entries for each vertex
          (cons
            (list
              (nth (- (* vinc 4) 4) 10to42)
              (nth (- (* vinc 4) 3) 10to42)
              (nth (- (* vinc 4) 2) 10to42)
              (nth (1- (* vinc 4)) 10to42)
            ); end list
            verts
          ); end cons & verts
        vinc (1- vinc) ; will be 0 at end
      ); end setq
    ); end repeat
    (while (nth (+ vinc 2) verts); still at least 2 more vertices
      (if
        (or ; only possible if chose to Retain arc segments
          (/= (cdr (assoc 42 (nth vinc verts))) 0.0); next segment is arc
          (/= (cdr (assoc 42 (nth (1+ vinc) verts))) 0.0); following segment is arc
        ); end or
        (setq vinc (1+ vinc)); then - don't straighten from here; move to next
        (progn ; else - analyze from current vertex
          (setq
            vert1 (cdar (nth vinc verts)) ; point-list location of current vertex
            vert2 (cdar (nth (1+ vinc) verts)); of next one
            vert3 (cdar (nth (+ vinc 2) verts)); of one after that
            ang1 (angle vert1 vert2)
            ang2 (angle vert2 vert3)
          ); end setq
          (if
            (or
              (equal ang1 ang2 0.0001); collinear, ignoring distance
              (and
                (<= (distance vert1 vert3) *distmax*)
                  ; straightens if direct distance from current vertex to two vertices later is
                  ; less than or equal to maximum; if preferred to compare distance along
                  ; Polyline through intermediate vertex, replace above line with this:
                  ; (<= (+ (distance vert1 vert2) (distance vert2 vert3)) *distmax*)
                (<=
                  (if (> (abs (- ang1 ang2)) pi); if difference > 180 degrees
                    (+ (min ang1 ang2) (- (* pi 2) (max ang1 ang2)))
                      ; then - compensate for change in direction crossing 0 degrees
                    (abs (- ang1 ang2)); else - size of difference
                  ); end if
                  *cidmax*
                ); end <=
              ); end and
            ); end or
            (setq verts (vl-remove (nth (1+ vinc) verts) verts))
              ; then - remove next vertext, stay at current vertex for next comparison
            (setq vinc (1+ vinc)); else - leave next vertex, move to it as new base
          ); end if - distance & change in direction analysis
        ); end progn - line segments
      ); end if - arc segment check
    ); end while - working through vertices
    (setq
      front (subst (cons 90 (length verts)) (assoc 90 front) front)
        ; update quantity of vertices for front end
      10to42 nil ; clear original set
    ); end setq
    (foreach x verts (setq 10to42 (append 10to42 x)))
      ; un-group four-list vertex sub-lists back to one list of all 10, 40, 41, 42 entries
    (setq pldata (append front 10to42 (list (last pldata))))
      ; put front end, vertex entries and extrusion direction back together
    (entmake pldata)
    (entdel (ssname plsel plinc)); remove original
    (setq plinc (1+ plinc)); go on to next Polyline
    (if ucschanged
      (progn
        (command "_.ucs" "_prev")
        (setq ucschanged nil) ; eliminate UCS reset in *error* since routine did it already
      ); end progn
    ); end if - UCS reset
  ); end repeat - stepping through set of Polylines
  (command "_.undo" "_end")
  (setvar 'cmdecho cmde)
  (princ)
); end defun - PLD
(prompt "\nType PLD to put PolyLines on a Diet.")

Weed Lisp

; Weeds out extranous verticies from a polyline

;=========================WEED.LSP===========================
;Jerry Workman CIS 70717,3564    December 28, 1987
;      Last modified February 21, 1991
;============================================================

;*----- this is executed at load

(textscr)
(princ(strcat
  "\n\n=========================WEED.LSP==========================="
  "\n\nWEED removes extranious verticies from LINEs or a POLYLINE."
  "\nShort segments less than the specified leg length ...AND..."
  "\nhaving an offset distance less than the minimum distance"
  "\nare removed. Try different combinations to get the result"
  "\ndesired. Changes can be undone by entering the U command"
  "\ntwice. The routine will convert LINEs to a POLYLINE providing"
  "\nthat all line segments endpoints match exactly. Additional"
  "\nverticies that have been added by a Spline or Fit curve can"
  "\nbe treated like \"real\" verticies, or can be ignored."
  "\n\nExample:    "
  "\nEnter offset distance: 10 <Enter number or pick 2 pts>"
  "\nEnter leg length: 100 <Enter number or pick 2 pts>"
  "\n\nAll included verticies having the longest leg less than 100"
  "\nAND being less than 10 from the original line will be removed."
  "\nIf you wish offset to control select a large leg length."
  "\nIf you wish leg length to control select a large offset."
  "\nJerry Workman CIS 70717,3564"
  "\nLoading..."))

;*----- Debugging stuff, load this file by entering LD<RETURN>

;(defun c:ld() (load "weed"))
;(defun c:ed() (command "q" "d:\\acad\\support\\weed.lsp"))

;*----- Error Routine

(defun w-error (s) (redraw) (grtext)
  (princ "\nWeed Error: ") (princ s)
  (exit)
)

;*----- Exit Routine

(defun exit()
  (if (boundp 'f) (setq f (close f)))
  (setvar "cmdecho"  cmdecho)
  (setvar "blipmode" blipmode)
  (setq *error* olderr)
  (princ)
)

;*----- Extract a field from a list

(defun fld (num lst) (cdr (assoc num lst)))

;*----- Plot a temporary X

(defun blip (blpoint / s x1 y1 x2 y2 p1 p2 p3 p4)

   (setq s  (/ (getvar "viewsize") 100)      ; 1/100 of viewsize
         x1 (+ (car blpoint) s)
         y1 (- (cadr blpoint) s)
         x2 (- (car blpoint) s)
         y2 (+ (cadr blpoint) s)
         p1 (list x1 y1) p2 (list x2 y2)
         p3 (list x2 y1) p4 (list x1 y2))
   (grdraw p1 p2 -1) (grdraw p3 p4 -1)
)

;*----- Convert a line to a polyline entity

(defun line2pline(ent / dat etype epnt ss1 ss2)
  (if ent (progn
    (setq dat   (entget ent)
          etype (fld 0 dat))
    (if (= etype "LINE") (progn
      (princ "\nConverting LINE to PLINE")
      (setq epnt (fld 10 dat)
            ss1 (ssadd ent)
            ss2 (ssget "C" (getvar "EXTMIN") (getvar "EXTMAX")))
      (ssdel ent ss2)
      (command "pedit" ss1 "y" "j" ss2 "" "x")
      (ssname (ssget epnt) 0) ; return the new entity name
    )
    ;else return nil
      (progn (princ "\nNot a Line")
        nil)
    )
  );else
  (progn
    (princ "\nNothing selected")
    nil)
  )
)

;*-----  Get a polyline or line entity

(defun fetch(/ pl etyp flgs ans)
  (setq etyp nil)
  (while (not (or (= etyp "LINE") (= etyp "POLYLINE"))) (progn
    (setq ename nil)
    (setq e (car (entsel "\nSelect a PolyLine or Line: ")))
    (if e (progn
      (setq pl   (entget e)
   etyp   (fld 0 pl)
   ename  e)
      (if (or (= etyp "LINE") (= etyp "POLYLINE")) (progn
(princ (strcat "\n" etyp " selected"))
(if (= etyp "LINE")
 (setq e      (line2pline e)
ename  e
pl     (entget e))
))
      ;else
(progn (princ "\nThat's not a LINE or POLYLINE, it's a ") (princ etyp))
      ); end if
    ); end progn
    ; else
      (princ "\nNothing Selected")
    ); end if
  )); end while
  (setq flgs   (fld 70 pl))
  (setq closed (=(boole 1 flgs 1) 1))
  (if closed (princ "\nClosed Polyline"))
  (cond
    ((=(boole 1 flgs 2) 2) (progn
      (setq ptyp "F")
      (princ "\nFit curve verticies have been added")))
    ((=(boole 1 flgs 4) 4) (progn
      (setq ptyp "S")
      (princ "\nSpline curve verticies have been added...")))
    (t (setq ptyp "N"))      ;Normal polyline
  )
  (if(/= ptyp "N") (progn
    (initget "Y N")
    (if(= (getkword "\nDecurve polyline during weeding[y/N]:") "Y")
      (setq ptyp "N"))
  ))
)

;*----- Check vertex type

(defun vt_ok ()
  (if (= etype "VERTEX")
    (cond
      ((= ptyp "F") (or(=(boole 1 flags 1) 1) (= flags 0)))
      ((= ptyp "S") (>(boole 1 flags 9) 0))
      (t    (=(boole 1 flags 25) 0)) ;"N" normal, 1 8 16 off
    )
  ;else
    t
  )
)

;*----- extract the list containing vertex coordinates

(defun get_vertex(/ vert etype sub_ent flags)
  (setq vert nil
        etype nil)
  (while (and e (null vert) (/= etype "SEQEND")) (progn
    (setq v     (entnext e)
          e     v
          etype nil)
    (if e (progn
      (setq sub_ent   (entget v)
   flags     (fld 70 sub_ent)
            etype     (fld 0  sub_ent))
      ;(princ "flags =")(princ flags)
      (if (vt_ok)
(if (= etype "VERTEX")
 (setq vert_cnt (1+ vert_cnt)
vert (fld 10 sub_ent))
; else return
 nil
)
      )
    ))
  ))
)

;*----- Add a vertex to the temporary file for the new pline

(defun add_vert(vt)
  (if (null f) (setq f (open "weedtmp.$$$" "w")))
  (prin1 vt f)
  (princ "\n" f)
)

;*----- Read a vertex from the temporary file for the new pline

(defun read_vert(/ pt)
   (setq pt (read-line f))
   (if pt (read pt) nil)
)

;*----- Read new polyline from the tempory file

(defun retrieve()
    (setq f (open "weedtmp.$$$" "r"))
    (command ".PLINE")
    (setq v (read_vert))
    (while v (progn
      (command v)
      (setq v (read_vert))
    ))
    (command "")
   ;(command "del" "weedtmp.$$$")
)

;*----- Check the internal angle and leg lengths then add or delete

(defun check_it(/ ang dist1 dist2 dist offset off)
  (setq ang12  (abs(angle v1 v2))
ang13  (abs(angle v1 v3))
ang    (abs(- ang12 ang13))
dist1  (distance v1 v2)
dist2  (distance v2 v3)
dist   (max dist1 dist2)       ; largest distance
off    (* dist1 (sin ang))
offset (+ p_off off)
p_off  offset
  )
  (if
    (and
      (< offset max_offset) ;offset distance criteria
      (< dist min_dist) ;minimum leg length criteria
    )
    ;then skip middle vertex
    (progn (blip v2) ;mark the deleted vertex
       (setq v2 v3
    v3 (get_vertex)
    skip_cnt (1+ skip_cnt))
      (princ "\nSkipping vertex # ") (princ (- vert_cnt 2))
;     (princ (strcat ", max_offset " (rtos max_offset 2 2) "
; min_dist " (rtos min_dist 2 2)))
;     (princ (strcat ", offset " (rtos offset 2 2) " dist " (rtos dist 2 2)))
    )
  ;else add first vertex to list
    (progn
      (add_vert v2)
      (setq v1 v2
            v2 v3
   v3 (get_vertex)
   p_off  0)
    ); end progn
  ); end if
)

;*----- The main routine...

(defun C:WEED( / v1 v2 v3 ename v skip_cnt vert_cnt cmdecho blipmode f
olderr max_offset min_dist closed spline fit e_del
p_off vstart ptyp)

  (setq cmdecho  (getvar "cmdecho")
        blipmode (getvar "blipmode")
olderr *error*
*error*  w-error
;  *error* nil
skip_cnt 0
p_off 0
f nil
vert_cnt 0
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (initget (+ 1 2 4))
  (setq max_offset (getdist "\nEnter offset distance: "))
  (initget (+ 1 2 4))
  (setq min_dist (getdist "\nEnter leg length: "))
  (initget "Y N")
  (setq e_del (getkword "\nDelete original Polyline [Y/n]: "))
  (if (null e_del) (setq e_del "Y"))
  (fetch)
  (princ "\nChecking polyline verticies...")
  (setq v1 (get_vertex)
vstart v1
v2 (get_vertex)
        v3 (get_vertex))
  (add_vert v1)
  (while v3 (check_it))
  (if (< (distance v1 v2) min_dist)
    (progn (setq skip_cnt (1+ skip_cnt))
  (princ "\nSkipping vertex # ") (princ vert_cnt))
  ;else
    (add_vert v1)
  ); end if
  (add_vert v2)
  (if closed (add_vert vstart))
  ; Delete old line and draw new Pline
  (if (> skip_cnt 0) (progn
    (close f)
    (if (= e_del "Y") (entdel ename))
    (retrieve)
    (princ (strcat "\n" (itoa skip_cnt) " verticies removed "
  "out of " (itoa vert_cnt) " tested ("
  (rtos(/ (* 100.0 skip_cnt) vert_cnt) 2 2)
  ") percent"))
  )
  ;else
    (princ "\nNothing to change!")
  )
  (exit)
)