Author Topic: Define and insert blocks with attributes , using DXF codes and lisp  (Read 3645 times)

0 Members and 1 Guest are viewing this topic.

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Hello everyone!

I am struggling to find the problem in the below lisp file :

Code: [Select]
(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
 (vl-CmdF "_.Purge" "_A" "" "_N")

 (if (tblSearch "Block" "PxT")
  (princ "\n  Block  Existed !")
  (progn ; Define Block
 ;  (setVar "TextStyle" "Standard")
 ;  (vl-CmdF "_.Purge" "_A" "" "_N")
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")

   (if (tblSearch "Style" "ArialT") T (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
 
   (entMake '((0 . "BLOCK") (2 . "PxT") (70 . 2) (8 . "0") (10 0 0 0) (6 . "ByLayer") (62 . 256) (4 . "Made by Me"))  ) ; end of e
   (entMake (list '(0 . "Circle") '(8 . "0") '(62 . 256) '(6 . "ByLayer") '(10 0 0 0) (cons 40 0.25) ) ) ; end of e

   (entMake (list '(0 . "AttDef") '(100 . "AcDbEntity") (cons 8 "0 Name") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(100 . "AcDbText") '(10 0 0 0) '(40 . 1.5) '(1 . "N") '(50 . 0) '(41 . 1) '(51 . 0) '(7 . "ArialT") '(71 . 0) '(72 . 0)
                         '(11 0.5 +1.0 0) '(210 0.0 0.0 1.0)
                  '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) ; end of e                     '(100 . "AcDbXrecord")

   (entMake '((0 . "EndBlk") (8 . "0")) ) ; end of e
   (prinC "\n   Block  with  Attributes  DEFINED  :  PxT  ;") ; end of p
  ) ; else
 ) ; if

 (setq i 0)
 (repeat 10 ; Inserting 10 Blocks with Attribute
  (entMake (list '(0 . "Insert") '(2 . "PxT") '(8 . "0") '(66 . 1) (cons 10 (trans (list i i i) 1 0)) '(50 . 0) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)) ) ; inserare Bloc

  (entMake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
                 '(100 . "AcDbText") (list 10 i i i) '(40 . 1) (cons 1 (ItoA i)) '(50 . 0) '(41 . 1.0) '(51 . 0.0) '(7 . "ArialT") '(71 . 0)
                       (cons 72 0) (cons 11 (trans (list i i i) 1 0)) ;'(210 0.0 0.0 1.0)
                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute
 
  (entMake '((0 . "SeqEnd") (8 . "0")) ) ; End Insert Block !

  (setq i (1+ i)) 
 ) ; r

 (prinC (strCat "\n   Inserted  :  " (ItoA i) "  ;"))
 (prinC "\n   TestPP  :  END  ;") (prinC)
) ; defun


1 . So , open a new Autocad file , load and run the program .

2 . delete everything and run the code again .

The attributes are not visible .

What is the problem ?  Text Style or Insertion of Attribute definition ?

Thanks in advance !
« Last Edit: April 08, 2019, 02:45:46 PM by CostinBos77 »
Land surveyor in action !!!

:yes:

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #1 on: April 07, 2019, 04:33:23 AM »
It is very interesting , if the TextStyle Arial is preserved in an other Text Style or my TextStyle AriaT was not Purged from the drawing , there is no problem .


So , why is no problem in the beginning then ?

Code: [Select]
((-1 . <Entity name: 2a071cfed0>) (0 . "ATTRIB") (330 . <Entity name: 2a071cfec0>) (5 . "29D")
 (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "Name L")
(100 . "AcDbText") (10 9.0 9.0 9.0) (40 . 1.0) (1 . "9") (50 . 0.0) (41 . 1.0) (51 . 0.0)
(100 . "AcDbAttribute") (280 . 0) (2 . "NAME") (70 . 0) (73 . 0) (74 . 2) (280 . 1))

nothing about TextStyle (7 . "ArialT") in the object list , But it is available in dwg .
« Last Edit: April 07, 2019, 05:21:36 AM by CostinBos77 »
Land surveyor in action !!!

:yes:

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #2 on: April 07, 2019, 09:16:26 PM »
Should it be a (if (not I think there is something wrong in the IF
A man who never made a mistake never made anything

Dlanor

  • Bull Frog
  • Posts: 263
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #3 on: April 08, 2019, 01:49:36 PM »
Should it be a (if (not I think there is something wrong in the IF

Perhaps

Code - Auto/Visual Lisp: [Select]
  1.  (if not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #4 on: April 08, 2019, 03:06:48 PM »
Unfortunately ,

Quote
(if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;

is not making any difference .


Code: [Select]
(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
 (vl-CmdF "_.Purge" "_A" "" "_N")

 (if (tblSearch "Block" "PxT")
  (princ "\n  Block  Existed !")
  (progn ; Define Block
 ;  (setVar "TextStyle" "Standard")
 ;  (vl-CmdF "_.Purge" "_A" "" "_N")
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")

   (if (tblSearch "Style" "ArialT") T (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
 
   (entMake '((0 . "BLOCK") (2 . "PxT") (70 . 2) (8 . "0") (10 0 0 0) (6 . "ByLayer") (62 . 256) (4 . "Made by Me"))  ) ; end of e
   (entMake (list '(0 . "Circle") '(8 . "0") '(62 . 256) '(6 . "ByLayer") '(10 0 0 0) (cons 40 0.25) ) ) ; end of e

   (entMake (list '(0 . "AttDef") '(100 . "AcDbEntity") (cons 8 "0 Name") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(100 . "AcDbText") '(10 0 0 0) '(40 . 1.5) '(1 . "N") '(50 . 0) '(41 . 1) '(51 . 0) '(7 . "ArialT")
                          '(71 . 0) '(72 . 0) '(11 0.5 +1.0 0) '(210 0.0 0.0 1.0)
                  '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) ; end of e                     '(100 . "AcDbXrecord")

   (entMake '((0 . "EndBlk") (8 . "0")) ) ; end of e
   (prinC "\n   Block  with  Attributes  DEFINED  :  PxT  ;") ; end of p
  ) ; else
 ) ; if

 (setq i 0)
 (repeat 10 ; Inserting 10 Blocks with Attribute
  (entMake (list '(0 . "Insert") '(2 . "PxT") '(8 . "0") '(66 . 1) (cons 10 (trans (list i i i) 1 0)) '(50 . 0) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)) ) ; inserare Bloc

;;;  (entMake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
;;;                 '(100 . "AcDbText") (list 10 i i i) '(40 . 1) (cons 1 (ItoA i)) '(50 . 0) '(41 . 1.0) '(51 . 0.0) '(7 . "ArialT")
;;;                        '(71 . 0) (cons 72 0) (cons 11 (trans (list i i i) 1 0)) ;'(210 0.0 0.0 1.0)
;;;                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute

  (entMake (list '(0 . "ATTRIB") (list 10 i i i)  '(8 . "Name L") (cons 1 (ItoA i)) '(280 . 0) '(2 . "NAME") '(40 . 1) '(70 . 0)
             (cons 11 (trans (list i i i) 1 0)) (cons 72 0) (cons 74 2) '(6 . "ByLayer") '(7 . "ArialT") '(50 . 0) '(62 . 256) '(280 . 1) )  ) ; e

 
  (entMake '((0 . "SeqEnd") (8 . "0")) ) ; End Insert Block !

  (setq i (1+ i)) 
 ) ; r

 (prinC (strCat "\n   Inserted  :  " (ItoA i) "  ;"))
 (prinC "\n   TestPP  :  END  ;") (prinC)
) ; defun


I have used in the last 7 years almost every day the above function with Attrib defined without codes 100 .

Always is working very fine , but , '(280 . 1) is not having any effect for LockPosition for Attributes .

When I introduced codes 100LockPosition = On , but I have a problem with TextStyle .

If I remove  '(7 . "ArialT") , it is working fine as well , but ofcourse , TestStyle = Standard .
« Last Edit: April 09, 2019, 01:50:21 PM by CostinBos77 »
Land surveyor in action !!!

:yes:

Dlanor

  • Bull Frog
  • Posts: 263
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #5 on: April 08, 2019, 04:47:27 PM »
Oops code was wrong, Missing an opening brace. Try

Code - Auto/Visual Lisp: [Select]
  1. (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))

or

Code - Auto/Visual Lisp: [Select]
  1. (if (not (tblsearch "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))

Dlanor

  • Bull Frog
  • Posts: 263
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #6 on: April 08, 2019, 04:57:39 PM »
Or try this cond statement using visual lisp

Code - Auto/Visual Lisp: [Select]
  1.   (cond ( (null (tblsearch "STYLE" "ELEV_ARIAL_1"))
  2.                 nw_font (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf")
  3.           );end_setq
  4.           (mapcar '(lambda (pr val) (vlax-put-property nw_style pr val))
  5.             (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
  6.             (list nw_font 0.0 (/ (* 0.0 pi) 180) 1.0 0.0)
  7.           );end_mapcar
  8.         )
  9.   );end_cond
  10.  

Dlanor

  • Bull Frog
  • Posts: 263
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #7 on: April 09, 2019, 07:15:46 AM »
Oops code was wrong, Missing an opening brace. Try

Code - Auto/Visual Lisp: [Select]
  1. (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))

or

Code - Auto/Visual Lisp: [Select]
  1. (if (not (tblsearch "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))

After a 12hrs sleep, the problem is here

Code - Auto/Visual Lisp: [Select]
  1.  (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))

"_.Style" calls the dialog box version of the command, NOT the command line version. So change the one of the above to

Code - Auto/Visual Lisp: [Select]
  1.  (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N"))


CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #8 on: April 09, 2019, 01:48:59 PM »
I wanted to be true , but unfortunately , NO .

Code: [Select]
(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
 (vl-CmdF "_.Purge" "_A" "" "_N")

 (if (tblSearch "Block" "PxT")
  (princ "\n  Block  Existed !")
  (progn ; Define Block
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")

;;;   (if (tblSearch "Style" "ArialT") T (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
   (if (not (tblSearch "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
 
   (entMake '((0 . "BLOCK") (2 . "PxT") (70 . 2) (8 . "0") (10 0 0 0) (6 . "ByLayer") (62 . 256) (4 . "Made by Me"))  ) ; end of e
   (entMake (list '(0 . "Circle") '(8 . "0") '(62 . 256) '(6 . "ByLayer") '(10 0 0 0) (cons 40 0.25) ) ) ; end of e

   (entMake (list '(0 . "AttDef") '(100 . "AcDbEntity") (cons 8 "0 Name") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(100 . "AcDbText") '(10 0 0 0) '(40 . 1.5) '(1 . "N") '(50 . 0) '(41 . 1) '(51 . 0) '(7 . "ArialT") '(71 . 0) '(72 . 0)
                         '(11 0.5 +1.0 0) '(210 0.0 0.0 1.0)
                  '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) ; end of e                     '(100 . "AcDbXrecord")

   (entMake '((0 . "EndBlk") (8 . "0")) ) ; end of e
   (prinC "\n   Block  with  Attributes  DEFINED  :  PxT  ;") ; end of p
  ) ; else
 ) ; if

 (setq i 0)
 (repeat 10 ; Inserting 10 Blocks with Attribute
  (entMake (list '(0 . "Insert") '(2 . "PxT") '(8 . "0") '(66 . 1) (cons 10 (trans (list i i i) 1 0)) '(50 . 0) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)) ) ; inserare Bloc

  (entMake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
                 '(100 . "AcDbText") (list 10 i i i) '(40 . 1) (cons 1 (ItoA i)) '(50 . 0) '(41 . 1.0) '(51 . 0.0)  '(7 . "ArialT")
                        '(71 . 0) '(72 . 0) (cons 11 (trans (list i i i) 1 0)) ;'(210 0.0 0.0 1.0)
                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute

;;;  (entMake (list '(0 . "ATTRIB") (list 10 i i i)  '(8 . "Name L") (cons 1 (ItoA i)) '(280 . 0) '(2 . "NAME") '(40 . 1) '(70 . 0)
;;;             (cons 11 (trans (list i i i) 1 0)) (cons 72 0) (cons 74 2) '(6 . "ByLayer") '(7 . "ArialT") '(50 . 0) '(62 . 256) '(280 . 1) )  ) ; e
 
  (entMake '((0 . "SeqEnd") (8 . "0")) ) ; End Insert Block !

  (setq i (1+ i)) 
 ) ; r

 (setVar "TextStyle" "Standard") (command "zoom" "e")
 (prinC (strCat "\n   Inserted  :  " (ItoA i) "  ;"))
 (prinC "\n   TestPP  :  END  ;") (prinC)
) ; defun c:TestPP


OR

Code: [Select]
(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
 (vl-CmdF "_.Purge" "_A" "" "_N")

 (if (tblSearch "Block" "PxT")
  (princ "\n  Block  Existed !")
  (progn ; Define Block
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")

;;;   (if (tblSearch "Style" "ArialT") T (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblSearch "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;


   (cond ( (null (tblSearch "STYLE" "ELEV_ARIAL_1"))
          (setq nw_style (vla-Add (vla-get-textStyles (vla-get-ActiveDocument (vlax-get-acad-Object))) "ArialT")
                nw_font (strcat (getEnv "systemroot") "\\Fonts\\Arial.ttf")
          ) ;end_setq
          (mapcar '(lambda (pr val) (vlax-put-Property nw_style pr val))
            (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
            (list nw_font 0.0 (/ (* 0.0 pi) 180) 1.0 0.0)
          ) ;end_mapcar
        )
   ) ;end_cond
 
   (entMake '((0 . "BLOCK") (2 . "PxT") (70 . 2) (8 . "0") (10 0 0 0) (6 . "ByLayer") (62 . 256) (4 . "Made by Me"))  ) ; end of e
   (entMake (list '(0 . "Circle") '(8 . "0") '(62 . 256) '(6 . "ByLayer") '(10 0 0 0) (cons 40 0.25) ) ) ; end of e

   (entMake (list '(0 . "AttDef") '(100 . "AcDbEntity") (cons 8 "0 Name") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(100 . "AcDbText") '(10 0 0 0) '(40 . 1.5) '(1 . "N") '(50 . 0) '(41 . 1) '(51 . 0) '(7 . "ArialT") '(71 . 0) '(72 . 0)
                         '(11 0.5 +1.0 0) '(210 0.0 0.0 1.0)
                  '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) ; end of e                     '(100 . "AcDbXrecord")

   (entMake '((0 . "EndBlk") (8 . "0")) ) ; end of e
   (prinC "\n   Block  with  Attributes  DEFINED  :  PxT  ;") ; end of p
  ) ; else
 ) ; if

 (setq i 0)
 (repeat 10 ; Inserting 10 Blocks with Attribute
  (entMake (list '(0 . "Insert") '(2 . "PxT") '(8 . "0") '(66 . 1) (cons 10 (trans (list i i i) 1 0)) '(50 . 0) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)) ) ; inserare Bloc

  (entMake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
                 '(100 . "AcDbText") (list 10 i i i) '(40 . 1) (cons 1 (ItoA i)) '(50 . 0) '(41 . 1.0) '(51 . 0.0)  '(7 . "ArialT")
                        '(71 . 0) '(72 . 0) (cons 11 (trans (list i i i) 1 0)) ;'(210 0.0 0.0 1.0)
                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute

;;;  (entMake (list '(0 . "ATTRIB") (list 10 i i i)  '(8 . "Name L") (cons 1 (ItoA i)) '(280 . 0) '(2 . "NAME") '(40 . 1) '(70 . 0)
;;;             (cons 11 (trans (list i i i) 1 0)) (cons 72 0) (cons 74 2) '(6 . "ByLayer") '(7 . "ArialT") '(50 . 0) '(62 . 256) '(280 . 1) )  ) ; e
 
  (entMake '((0 . "SeqEnd") (8 . "0")) ) ; End Insert Block !

  (setq i (1+ i)) 
 ) ; r

 (setVar "TextStyle" "Standard") (command "zoom" "e")
 (prinC (strCat "\n   Inserted  :  " (ItoA i) "  ;"))
 (prinC "\n   TestPP  :  END  ;") (prinC)
) ; defun c:TestPP




I don't think the problem is coming from TextStyle . Because it is working on the first time and it is working if I remove codes  100 .


« Last Edit: April 09, 2019, 03:11:06 PM by CostinBos77 »
Land surveyor in action !!!

:yes:

CostinBos77

  • Mosquito
  • Posts: 19
  • Land surveyor in action !
Re: Define and insert blocks with attributes , using DXF codes and lisp
« Reply #9 on: April 09, 2019, 04:52:43 PM »
Now it is clear , I create a condition which is alternating the insertion of the attributes .

Open a new dwg , load and run the lisp . The only difference will be too many grips for blue and odd numbers , because (280 . 1) is not having any effect .

Delete all and run the lisp again . Only the blue and odd attributes are visible .

Code: [Select]
(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
 (vl-CmdF "_.Purge" "_A" "" "_N")

 (if (tblSearch "Block" "PxT")
  (princ "\n  Block  Existed !")
  (progn ; Define Block
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")

;;;   (if (tblSearch "Style" "ArialT") T (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "_.Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
;;;   (if (not (tblobjname "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;
   (if (not (tblSearch "Style" "ArialT")) (vl-CmdF "-Style" "ArialT" "Arial.ttf" 0 1 0 "_N" "_N") ) ;


;;;   (cond ( (null (tblSearch "STYLE" "ELEV_ARIAL_1"))
;;;          (setq nw_style (vla-Add (vla-get-textStyles (vla-get-ActiveDocument (vlax-get-acad-Object))) "ArialT")
;;;                nw_font (strcat (getEnv "systemroot") "\\Fonts\\Arial.ttf")
;;;          ) ;end_setq
;;;          (mapcar '(lambda (pr val) (vlax-put-Property nw_style pr val))
;;;            (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
;;;            (list nw_font 0.0 (/ (* 0.0 pi) 180) 1.0 0.0)
;;;          ) ;end_mapcar
;;;        )
;;;   ) ;end_cond
 
   (entMake '((0 . "BLOCK") (2 . "PxT") (70 . 2) (8 . "0") (10 0 0 0) (6 . "ByLayer") (62 . 256) (4 . "Made by Me"))  ) ; end of e
   (entMake (list '(0 . "Circle") '(8 . "0") '(62 . 256) '(6 . "ByLayer") '(10 0 0 0) (cons 40 0.25) ) ) ; end of e

   (entMake (list '(0 . "AttDef") '(100 . "AcDbEntity") (cons 8 "Name L"") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(100 . "AcDbText") '(10 0 0 0) '(40 . 1.5) '(1 . "N") '(50 . 0) '(41 . 1) '(51 . 0) '(7 . "ArialT") '(71 . 0) '(72 . 0)
                            '(11 0.5 +1.0 0) '(210 0.0 0.0 1.0)
                  '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) ; end of e                     '(100 . "AcDbXrecord")

   (entMake '((0 . "EndBlk") (8 . "0")) ) ; end of e
   (prinC "\n   Block  with  Attributes  DEFINED  :  PxT  ;") ; end of p
  ) ; else
 ) ; if

 (setq ;q (getString "\n   Attribute  Insertion  with  Codes  100  :  Any = NO  ;   <  Enter = YES  >  :  ")
       i 0)

 (repeat 10 ; Inserting 10 Blocks with Attribute
  (entMake (list '(0 . "Insert") '(2 . "PxT") '(8 . "0") '(66 . 1) (cons 10 (trans (list i i i) 1 0)) '(50 . 0) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0)) ) ; inserare Bloc

  (if (= (rem i 2) 0) ;(= q "")
  (entMake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
                 '(100 . "AcDbText") (list 10 i i i) '(40 . 1) (cons 1 (ItoA i)) '(50 . 0) '(41 . 1.0) '(51 . 0.0)  '(7 . "ArialT")
                        '(71 . 0) '(72 . 0) (cons 11 (trans (list i i i) 1 0)) ;'(210 0.0 0.0 1.0)
                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute


  (entMake (list '(0 . "ATTRIB") (list 10 i i i)  '(8 . "Name L") (cons 1 (ItoA i)) '(280 . 0) '(2 . "NAME") '(40 . 1) '(70 . 0)
             (cons 11 (trans (list i i i) 1 0)) (cons 72 0) (cons 74 2) '(6 . "ByLayer") '(7 . "ArialT") '(50 . 0) '(62 . 5) '(280 . 1) )  ) ; e
  ) ; if
  (entMake '((0 . "SeqEnd") (8 . "0")) ) ; End Insert Block !

  (setq i (1+ i)) 
 ) ; r

 (setVar "TextStyle" "Standard") (command "zoom" "e")
 (prinC (strCat "\n   Inserted  :  " (ItoA i) "  ;"))
 (prinC "\n   TestPP  :  END  ;") (prinC)
) ; defun c:TestPP


So , at the same time , the same block can have different appearances / properties as : color , height , layer rotation , etc .


« Last Edit: April 09, 2019, 05:08:24 PM by CostinBos77 »
Land surveyor in action !!!

:yes: