write text in dwg

write text in dwg

Anonymous
Not applicable
793 Views
2 Replies
Message 1 of 3

write text in dwg

Anonymous
Not applicable
hello. good morning. Lisp runs,  The result is output. and I want to write the result in dwg.
(command "text" (getpoint) "" "" ???      <--- I want to add this sentence. I need help

;;;
;;; Get info on all objs Inside a Polyline
;;;
(defun C:GIP (/ objSel PolyName)
 (setq objSel nil)
 (while (= objSel nil)
  (setq objSel (vlax-ename->vla-object
       (car (nentsel "\nSelect Polyline: "))
      )
  )
 )
 ;; Check it is closed.
 (if (not (vlax-curve-isClosed objSel))
  (progn
   (princ "\nIt must be a closed Polyline. Exiting.")
   (exit)
  )
 )

 (setq PolyName (vla-get-ObjectName objSel))
 (if (wcmatch PolyName "AcDb*Polyline")
  (FindCount objSel)
 )
)
(defun FindCount (obj / plist ss i)
 (setq plist (agroup (vlax-get obj "Coordinates")))
 (setq ss nil)
 (setq blks    (ssadd)
    txts    (ssadd)
    anyOther (ssadd)
 )
 ;; Acad gently selects all objs inside the polyline by us!!
 (setq ss (ssget "_WP" plist))
 (setq i (sslength ss))
 (while (not (minusp (setq i (1- i))))
  (setq ename (ssname ss i))
  (setq entList (entget ename))
  (cond ((= (cdr (assoc 0 entList)) "INSERT")
      (setq blks (ssadd ename blks))
     )
     ((= (cdr (assoc 0 entList)) "TEXT")
      (setq txts (ssadd ename txts))
     )
     ((= (cdr (assoc 0 entList)) "MTEXT")
      (setq txts (ssadd ename txts))
     )
     (T (setq anyOther (ssadd ename anyOther)))
  )
 )
 ;; Process by group of entities
 (setq blkRes (fun1 blks 2)) ; blk, names
 (setq txtRes (fun1 txts 1)) ; text, texts
 (setq anyRes (fun1 anyOther 62)) ; any, color.
 ;; Take this list for any further extension of this program
 (setq resList (list (cons 1 blkRes) ; blks
      (cons 2 txtRes) ; txts
      (cons 3 anyRes) ; anys
      )
 )
 (foreach n resList
  (fun2 n (car n))
 )
 (princ)
) ;_ defun

(defun fun1 (ss assocKey / i T_Entity propList propName)
 (setq propList nil)
 (setq i (sslength ss))
 (while (not (minusp (setq i (1- i))))
  (setq T_Entity (ssname ss i))
  (setq propList (if (not (assoc (setq propName
            (cdr (assoc
               assocKey
               (entget
                T_Entity
               )
              )
            )
            )
            proplist
        )
         )
         (append
          proplist
          (list (list propName 1))
         )
         (subst
          (list
           propName
           (1+ (cadr (assoc
             propName
             proplist
            )
            )
           )
          )
          (assoc propName
           proplist
          )
          proplist
         )
        )
  )
 )
)
(defun fun2 (l key)
 (cond ((= key 1) (setq ent "Blocks"))
    ((= key 2) (setq ent "Texts"))
    ((= key 3) (setq ent "Other Objects"))
    (T "Unknown")
 )
 (princ (strcat "\n ** Total number of "
       ent
       " found: "
       (itoa (SumAll (cdr l)))
     )
 )
 (PrintThem (cdr l))
)
;;;;;; helpers ;;;;;;;;
(defun PrintThem (l)
 (foreach n
      (vl-sort
       l
       '(lambda (e1 e2)
      (< (car e1) (car e2))
     )
      )
  (princ
   (strcat
    "\n"
    (cond ((not (car n)) "Bylayer")
       ((= (car n) 0) "Byblock")
       ((= (type (car n)) 'INT) (getColorName (car n)))
       (T (car n))
    )
    ": "
    (itoa (cadr n))
   ) ;_ strcat
  )
 )
)
(defun getColorName (i)
 (cond ((= i 1) "Red")
    ((= i 2) "Yellow")
    ((= i 3) "Green")
    ((= i 4) "Cyan")
    ((= i 5) "Blue")
    ((= i 6) "Magenta")
    ((= i 7) "White")
    (T (itoa i))
 )
)
(defun SumAll (l)
 (apply '+
     (mapcar
      '(lambda (x)
     (cadr x)
    )
      l
     )
 )
)
(defun agroup (l)
 (if l
  (cons (list (car l) (cadr l)) (agroup (cddr l)))
 )
)
 ;|≪Visual LISPⓒ Format Options≫
(72 4 12 2 nil "_" 60 12 0 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;
0 Likes
Accepted solutions (1)
794 Views
2 Replies
Replies (2)
Message 2 of 3

dbhunia
Advisor
Advisor
Accepted solution

check this.......

 

(defun C:GIP (/ objSel PolyName)
 (setq objSel nil)
 (while (= objSel nil)
  (setq objSel (vlax-ename->vla-object
       (car (nentsel "\nSelect Polyline: "))
      )
  )
 )
 ;; Check it is closed.
 (if (not (vlax-curve-isClosed objSel))
  (progn
   (princ "\nIt must be a closed Polyline. Exiting.")
   (exit)
  )
 )

 (setq PolyName (vla-get-ObjectName objSel))
 (if (wcmatch PolyName "AcDb*Polyline")
  (FindCount objSel)
 )
)
(defun FindCount (obj / plist ss i All_Txt_To_Write)
 (setq plist (agroup (vlax-get obj "Coordinates")))
 (setq ss nil)
 (setq blks    (ssadd)
    txts    (ssadd)
    anyOther (ssadd)
 )
 ;; Acad gently selects all objs inside the polyline by us!!
 (setq ss (ssget "_WP" plist))
 (setq i (sslength ss))
 (while (not (minusp (setq i (1- i))))
  (setq ename (ssname ss i))
  (setq entList (entget ename))
  (cond ((= (cdr (assoc 0 entList)) "INSERT")
      (setq blks (ssadd ename blks))
     )
     ((= (cdr (assoc 0 entList)) "TEXT")
      (setq txts (ssadd ename txts))
     )
     ((= (cdr (assoc 0 entList)) "MTEXT")
      (setq txts (ssadd ename txts))
     )
     (T (setq anyOther (ssadd ename anyOther)))
  )
 )
 ;; Process by group of entities
 (setq blkRes (fun1 blks 2)) ; blk, names
 (setq txtRes (fun1 txts 1)) ; text, texts
 (setq anyRes (fun1 anyOther 62)) ; any, color.
 ;; Take this list for any further extension of this program
 (setq resList (list (cons 1 blkRes) ; blks
      (cons 2 txtRes) ; txts
      (cons 3 anyRes) ; anys
      )
 )
 (foreach n resList
	(foreach e (fun2 n (car n))
		(setq All_Txt_To_Write (cons e All_Txt_To_Write))
	)
 )
 (Write_Text All_Txt_To_Write)
 (princ)
);_ defun
(defun fun1 (ss assocKey / i T_Entity propList propName)
 (setq propList nil)
 (setq i (sslength ss))
 (while (not (minusp (setq i (1- i))))
  (setq T_Entity (ssname ss i))
  (setq propList (if (not (assoc (setq propName
            (cdr (assoc
               assocKey
               (entget
                T_Entity
               )
              )
            )
            )
            proplist
        )
         )
         (append
          proplist
          (list (list propName 1))
         )
         (subst
          (list
           propName
           (1+ (cadr (assoc
             propName
             proplist
            )
            )
           )
          )
          (assoc propName
           proplist
          )
          proplist
         )
        )
  )
 )
)
(defun fun2 (l key / DES)
 (cond ((= key 1) (setq ent "Blocks"))
    ((= key 2) (setq ent "Texts"))
    ((= key 3) (setq ent "Other Objects"))
    (T "Unknown")
 )
 (princ (setq DES (strcat "\n ** Total number of "
			   ent
			   " found: "
			   (itoa (SumAll (cdr l)))
			 )
		)
 )
 (PrintThem (cdr l) DES)
)
;;;;;; helpers ;;;;;;;;
(defun PrintThem (l DES / All_Txt_PrintThem)
(setq All_Txt_PrintThem (cons DES All_Txt_PrintThem))
 (foreach n
      (vl-sort
       l
       '(lambda (e1 e2)
      (< (car e1) (car e2))
     )
      )
	(setq All_Txt_PrintThem 
		(cons
			(princ
				(strcat
					"\n"
					(cond ((not (car n)) "Bylayer")
					   ((= (car n) 0) "Byblock")
					   ((= (type (car n)) 'INT) (getColorName (car n)))
					   (T (car n))
					)
					": "
					(itoa (cadr n))
				) ;_ strcat
			)
			All_Txt_PrintThem
		)
	)
 )
 (setq All_Txt_PrintThem (reverse All_Txt_PrintThem))
 All_Txt_PrintThem
)
(defun getColorName (i)
 (cond ((= i 1) "Red")
    ((= i 2) "Yellow")
    ((= i 3) "Green")
    ((= i 4) "Cyan")
    ((= i 5) "Blue")
    ((= i 6) "Magenta")
    ((= i 7) "White")
    (T (itoa i))
 )
)
(defun SumAll (l)
 (apply '+
     (mapcar
      '(lambda (x)
     (cadr x)
    )
      l
     )
 )
)
(defun agroup (l)
 (if l
  (cons (list (car l) (cadr l)) (agroup (cddr l)))
 )
)
(defun Write_Text (lst / N cmd)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq N (length lst))
(command "text" (getpoint "\nPick Insertion Point of text...") "" (nth (setq N (- N 1)) lst))
   (while (> N 0)
	(command "text" "" (nth (setq N (- N 1)) lst))
   )
(setvar 'cmdecho cmd)
)

 

 


Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....
0 Likes
Message 3 of 3

Anonymous
Not applicable

thank you always.  dbhunia

 

(command "text" (getpoint "\nPick Insertion Point of text...") "" (nth (setq N (- N 1)) lst))

added <"">

(command "text" (getpoint "\nPick Insertion Point of text...") "" "" (nth (setq N (- N 1)) lst))

0 Likes