Define and insert blocks with attributes , using DXF codes and AutoLisp

Define and insert blocks with attributes , using DXF codes and AutoLisp

Anonymous
Not applicable
8,574 Views
60 Replies
Message 1 of 61

Define and insert blocks with attributes , using DXF codes and AutoLisp

Anonymous
Not applicable

Hello everyone !

 

I am trying to define a block with attributes with LockPosition = On , using DXF codes (280 . 1)  and AutoLisp (lisp c: TestPP attached below ) . For Visual Lisp , property LockPosition = Read Only , so can't be changed !

 

The problem is , this (280 . 1)  is having effect only if I introducing codes 100 in blue . But then , I have a problem with TextStyle (7 . "ArialT")  .

 

(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

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 . 

 

For a manual insertion , TextStyle for attribute is Standard . 

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

 

If I keep the TextStyle ArialT preserved in the drawing , as current Text Style or used somewhere else , are NO problems . 

 

Any idea ? 

 

Thanks in advance .

 

 

0 Likes
Accepted solutions (1)
8,575 Views
60 Replies
Replies (60)
Message 2 of 61

Moshe-A
Mentor
Mentor

@Anonymous  hi,

 

I am trying to define a block with attributes with LockPosition = On , using DXF codes (280 . 1)  and AutoLisp (lisp c: TestPP attached below ) . For Visual Lisp , property LockPosition = Read Only , so can't be changed !

you are right, it seems that dxf code 280 can not be changed but it is not read only cause you can change it with ActiveX.

 

The problem is , this (280 . 1)  is having effect only if I introducing codes 100 in blue . But then , I have a problem with TextStyle (7 . "ArialT")  .

using (entmake) it's better to include the minimum dxf codes that needed to construct the entity and skip the codes with default values. 

 

here is my fixed code and it works Smiley LOL

 

enjoy

moshe

 

 

 

(defun c:TestPP (/ attdef_lock_position ; local function
		   bname)

 (defun attdef_lock_position (/ AcDbBlockTableRecord)
  (setq AcDbBlockTableRecord (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) bname))
  
  (vlax-for AcDbEntity AcDbBlockTableRecord
   (if (eq (vla-get-objectName AcDbEntity) "AcDbAttributeDefinition")
    (vlax-put AcDbEntity 'lockPosition :vlax-true)
   )
   (vlax-release-object AcDbEntity) 
  )

  (vlax-release-object AcDbBlockTableRecord)  
 ); attdef_lock_position

  
 (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.0 0.0) '(40 . 0.25) ) ) ; end of e

   (entMake (list '(0 . "ATTDEF") '(8 . "Name L") '(62 . 256) '(6 . "ByLayer") ;'(67 . 0)
                  '(10 0.0 0.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.0) '(210 0.0 0.0 1.0) '(3 . "Point Name") '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2))) ; end of e  ;'(100 . "AcDbXrecord") 

   (setq bname (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") '(8 . "Name L") '(67 . 0) ;'(6 . "ByLayer") ;'(62 . 256) '(67 . 0) ;0 = MSpace ;
                  (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)
                 '(2 . "NAME") '(70 . 0) '(73 . 0) '(74 . 2))) ; set Attribute
   ; else
   (entMake (list '(0 . "ATTRIB") (list 10 i i i)  '(8 . "Name L") (cons 1 (ItoA i)) '(2 . "NAME") '(40 . 1) '(70 . 0)
                   (cons 11 (trans (list i i i) 1 0)) '(72 . 0) '(74 . 2) '(6 . "ByLayer") '(7 . "ArialT") '(50 . 0) '(62 . 5))) ; 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

 

 

0 Likes
Message 3 of 61

Anonymous
Not applicable

Thank you very much Moshe-A ,

 

You need to introduce and call your function attdef_lock_position somewhere in the lisp 

 

(vlax-put AcDbEntity "LockPosition" :vlax-true)

it is available only for definition of a block , in "ATTDEF" .

 

It is necessary to apply this setting again , for all attributes in the insertion process , for "ATTRIB" .

Otherwise ,  LockPosition will be OFF , as in the attached picture and dwg .

 

 

Unfortunately , 

_$ (vlax-dump-object attV T)
; IAcadAttributeReference: AutoCAD Attribute Reference Interface
; Property values:
.......
;   LockPosition (RO) = -1 ; READ ONLY !
........
;   ObjectName (RO) = "AcDbAttribute"
............
;   StyleName = "ArialT"

...........

So , can't be used :

(vla-put-LockPosition attV :vlax-true)

Only (280 . 1) it is working , but only together with all 100's codes : (100 . "AcDbAttribute") ...

 

Run the lisp , and after that use next code :

(setq b (entlast)  a1 (entnext b)  attV (vlax-ename->Vla-Object a1)  lA1 (entget a1) )
 (vlax-dump-object attV T)

 

I am still thinking , maybe this (7 . "ArialT") should be followed by special code , or should be in the other position .

The TextStyle (7 . "ArialT") . it is having effect only after (100 . "AcDbText") .

 

I have attached as well a pdf file for DXF description for AutoCAD 2009 , page 79 . In this book , code 7 : (7 . "ArialT") 

it is part of (100 . "AcDbAttribute") . I have tried , but is not working at all .

 

Anyway , It is very strange !

 

0 Likes
Message 4 of 61

Moshe-A
Mentor
Mentor

@Anonymous ,

 

first my apology about miss call to (attdef_lock_position) function, it's was very late and want to go to bed (but it popup over my sleep)

 

i also did not have success in locking the position and it's true it is weird but why insist? if it does not work this way go with another, use (command "insert")

 

moshe

 

0 Likes
Message 5 of 61

Anonymous
Not applicable

Hello Moshe ,

 

I really need this,  because I am using it many times per day. 

 

A command "insert" .... will be very slow for 5000 blocks .

 

I find 2 tricks:

 

1. Preserve the text style as curent. 

 

(SetVar "TextStyle" "ArialT")

Do not be PURGE !

 

2. Remove (7 . "ArialT") from insertion,  and use Visual Lisp to change the Text Style = Standard in to "ArialT" , again  for 4 Attributes. 

 

Should be the right way somehow. 

 

0 Likes
Message 6 of 61

dbhunia
Advisor
Advisor

Try this way ....... (Roughly checked)

 

 

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

 (if (tblSearch "Block" "PxT")
  (princ "\nBlock  Existed !\n")
  (progn ; Define Block
   (command "_.Layer" "_N" "Name L" "_C" 1 "Name L" "")
   (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 "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") '(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)) '(62 . 5) ;'(210 0.0 0.0 1.0)
                 '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NAME") '(70 . 0) '(73 . 0) (cons 74 2) '(280 . 1) )  ) ; set Attribute
  ) ; 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)
)

 


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

Moshe-A
Mentor
Mentor

here is your solution ...  at the end of your lisp command call BATTMAN (only once)

 

 

 

 

 

 

0 Likes
Message 8 of 61

Anonymous
Not applicable

Thank you very much dbhunia .

 

I know this trick , but I am looking for a solution .

 

At the moment , I am preserving the TextStyle "ArialT" as the current one .

 

(setVar "TextStyle" "ArialT")

But , if I will use a different TextStyle as current , after PURGE command , I will lose my "ArialT" .

 

And will not work againe .

 

Regards ,

 

Costin

0 Likes
Message 9 of 61

Moshe-A
Mentor
Mentor

sorry, meant ATTSYNC

 

 

0 Likes
Message 10 of 61

Anonymous
Not applicable

Hello Meshe ,

 

1. try to use ATTSYNC on attached dwg , and you will see the problem .

 

Unfortunately , ALL the Attributes will jump on the right side .

 

2. try to use ATTSYNC on the second attachment 'Test 3 .dwg' . Is not working .

0 Likes
Message 11 of 61

Moshe-A
Mentor
Mentor

of course it jumps cause attsync synchronize what is defined in the block definition

to solve this,  consider to create 2 blocks with attributes locked on each side.

 

 

0 Likes
Message 12 of 61

Anonymous
Not applicable

Unfortunately , are more than 2 positions. 

 

Picture attached .

0 Likes
Message 13 of 61

Anonymous
Not applicable

It is a conflict in the next code , between Textstyle "ArialT" and "ATTRIB" DXF definition .

 

  (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

(7 . "ArialT") should be in another location or ...?

 

Because , with (7 . "Standard") , it is absolutely NO problem .

 

Next code is running all the time fine :

 

(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) )  )

But , unfortunately , (280 . 1) is not applying .

 

How ? Why ? Are the same settings , but in a slightly different way .

0 Likes
Message 14 of 61

Moshe-A
Mentor
Mentor

you can not have it all

i tried locking the attributes layers and even then ATTSYNC caused them to jump

 

 

 

 

0 Likes
Message 15 of 61

Moshe-A
Mentor
Mentor

maybe it is related to true type fonts

does it works with shx?

 

 

0 Likes
Message 16 of 61

CADaSchtroumpf
Advisor
Advisor

Hi,

This example (make with your drawing) can help you?

(defun c:BlockAttPT ( / );(num lst_posatt dxf_210 pto x y z ang pos_att)
	(cond
		((eq (getvar "cvport") 1)
			(princ "\n** Only in space object.")
		)
		(T
			(if (not (tblsearch "STYLE" "ArialTopo"))
				(entmake
					'(
					(0 . "STYLE")
					(5 . "40")
					(100 . "AcDbSymbolTableRecord")
					(100 . "AcDbTextStyleTableRecord")
					(2 . "ArialTopo")
					(70 . 0)
					(40 . 0.0)
					(41 . 1.0)
					(50 . 0.0)
					(71 . 0)
					(42 . 2.5)
					(3 . "arial.ttf")
					(4 . "")
					)
				)
			)
			(if (not (tblsearch "BLOCK" "PunctT"))
				(progn
					(entmake
						'((0 . "BLOCK") (2 . "PunctT") (70 . 2) (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2) (10 0.0 0.0 0.0))
					)
					(entmake
						'(
							(0 . "LWPOLYLINE")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0")
							(100 . "AcDbPolyline")
							(90 . 5)
							(70 . 0)
							(43 . 0.0)
							(38 . 0.0)
							(39 . 0.0)
							(10 0.353553 0.353553)
							(40 . 0.0)
							(41 . 0.0)
							(42 . 0.0)
							(91 . 0)
							(10 -0.353553 -0.353553)
							(40 . 0.0)
							(41 . 0.0)
							(42 . 0.0)
							(91 . 0)
							(10 0.0 0.0)
							(40 . 0.0)
							(41 . 0.0)
							(42 . 0.0)
							(91 . 0)
							(10 0.353553 -0.353553)
							(40 . 0.0)
							(41 . 0.0)
							(42 . 0.0)
							(91 . 0)
							(10 -0.353553 0.353553)
							(40 . 0.0)
							(41 . 0.0)
							(42 . 0.0)
							(91 . 0)
							(210 0.0 0.0 1.0)
						)
					)
					(entmake
						'(
							(0 . "CIRCLE")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0")
							(100 . "AcDbCircle")
							(10 0.0 0.0 0.0)
							(40 . 0.25)
							(210 0.0 0.0 1.0)
						)
					)
					(entmake
						'(
							(0 . "ATTDEF")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Name")
							(100 . "AcDbText")
							(10 0.5 0.25 0.0)
							(40 . 1.5)
							(1 . "")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
							(72 . 0)
							(11 0.5 1.0 0.0)
							(210 0.0 0.0 1.0)
							(100 . "AcDbAttributeDefinition")
							(280 . 0)
							(3 . "Dati DENUMIRE Punct  : ")
							(2 . "DENUMIRE")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 1)
						)
					)
					(entmake
						'(
							(0 . "ATTDEF")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Height")
							(100 . "AcDbText")
							(10 0.5 -1.75 0.0)
							(40 . 1.5)
							(1 . "")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
							(72 . 0)
							(11 0.5 -1.0 0.0)
							(210 0.0 0.0 1.0)
							(100 . "AcDbAttributeDefinition")
							(280 . 0)
							(3 . "Dati COTA Punct  : ")
							(2 . "COTA")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 1)
						)
					)
					(entmake
						'(
							(0 . "ATTDEF")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Code")
							(100 . "AcDbText")
							(10 0.5 0.025 0.0)
							(40 . 0.15)
							(1 . "")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
							(72 . 0)
							(11 0.5 0.1 0.0)
							(210 0.0 0.0 1.0)
							(100 . "AcDbAttributeDefinition")
							(280 . 0)
							(3 . "Dati COD Punct  : ")
							(2 . "COD")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 1)
						)
					)
					(entmake
						'(
							(0 . "ATTDEF")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Description")
							(100 . "AcDbText")
							(10 0.5 -0.175 0.0)
							(40 . 0.15)
							(1 . "")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
							(72 . 0)
							(11 0.5 -0.1 0.0)
							(210 0.0 0.0 1.0)
							(100 . "AcDbAttributeDefinition")
							(280 . 0)
							(3 . "Dati DESCRIERE Punct  : ")
							(2 . "DESCRIERE")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 1)
						)
					)
					(entmake '((0 . "ENDBLK") (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2)))
				)
			)
			(initget "Rigth Left")
			(if (eq (getkword "\nAt Rigth or Left? [Rigth/Left]<Rigth>: ") "Left")
				(setq lst_posatt '((-0.05 0.10 0.0) (-0.05 -0.1 0.0) (-0.05 0.01 0.0) (-0.05 -0.01 0.0)))
				(setq lst_posatt '((0.05 0.10 0.0) (0.05 -0.1 0.0) (0.05 0.01 0.0) (0.05 -0.01 0.0)))
			)
			(setq num 0 dxf_210 (trans '(0 0 1) 1 0 T))
			(while (setq pto (getpoint "\nInsertion point: "))
				(setq
					x (car pto)
					y (cadr pto)
					z (caddr pto)
					ang 0.0
					pos_att (mapcar '(lambda (x) (polar (trans '(0.0 0.0 0.0) dxf_210 0) (+ (angle (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)) ang) (distance (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)))) lst_posatt)
				)
				(entmake
					(append
						'(
							(0 . "INSERT")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Symbol")
							(100 . "AcDbBlockReference")
							(66 . 1)
							(2 . "PunctT")
							(41 . 0.1)
							(42 . 0.1)
							(43 . 0.1)
							(50 . 0.0)
							(70 . 0)
							(71 . 0)
							(44 . 0.0)
							(45 . 0.0)
						)
						(list (cons 10 (trans pto 0 dxf_210)) (cons 210 dxf_210))
					)
				)
				(entmake
					(append
						'(
							(0 . "ATTRIB")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Name")
							(100 . "AcDbText")
						)
						(list
							(cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 1 (itoa (setq num (1+ num))))
						)
						'(
							(40 . 0.15)
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
						)
						(list
							(if (< (caar pos_att) 0)
								'(72 . 2)
								'(72 . 0)
							)
							(cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 210 dxf_210)
						)
						'(
							(100 . "AcDbAttribute")
							(280 . 0)
							(2 . "DENUMIRE")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 0)
						)
					)
				)
				(setq pos_att (cdr pos_att))
				(entmake
					(append
						'(
							(0 . "ATTRIB")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Height")
							(100 . "AcDbText")
							(10 554053.0 336372.0 0.0)
							(40 . 0.15)
							(50 . 0.0)
						)
						(list
							(cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 1 (rtos z 2 3))
						)
						'(
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
						)
						(list
							(if (< (caar pos_att) 0)
								'(72 . 2)
								'(72 . 0)
							)
							(cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 210 dxf_210)
						)
						'(
							(100 . "AcDbAttribute")
							(280 . 0)
							(2 . "COTA")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 0)
						)
					)
				)
				(setq pos_att (cdr pos_att))
				(entmake
					(append
						'(
							(0 . "ATTRIB")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Code")
							(100 . "AcDbText")
						)
						(list
							(cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 1 (rtos 52.00 2 2))
						)
						'(
							(40 . 0.015)
							(1 . "52.00")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
						)
						(list
							(if (< (caar pos_att) 0)
								'(72 . 2)
								'(72 . 0)
							)
							(cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 210 dxf_210)
						)
						'(
							(100 . "AcDbAttribute")
							(280 . 0)
							(2 . "COD")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 0)
						)
					)
				)
				(setq pos_att (cdr pos_att))
				(entmake
					(append
						'(
							(0 . "ATTRIB")
							(100 . "AcDbEntity")
							(67 . 0)
							(410 . "Model")
							(8 . "0 Point Description")
							(100 . "AcDbText")
						)
						(list
							(cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
						)
						'(
							(40 . 0.015)
							(1 . "Taluz Dr /= 52 S")
							(50 . 0.0)
							(41 . 1.0)
							(51 . 0.0)
							(7 . "ArialTopo")
							(71 . 0)
						)
						(list
							(if (< (caar pos_att) 0)
								'(72 . 2)
								'(72 . 0)
							)
							(cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
							(cons 210 dxf_210)
						)
						'(
							(100 . "AcDbAttribute")
							(280 . 0)
							(2 . "DESCRIERE")
							(70 . 0)
							(73 . 0)
							(74 . 2)
							(280 . 0)
						)
					)
				)
				(entmake '((0 . "SEQEND") (62 . 256) (6 . "ByLayer") (370 . -2)))
			)
		)
	)
	(prin1)
)
0 Likes
Message 17 of 61

Anonymous
Not applicable

no , with ttf 

 

(vl-CmdF "-Style" "ArialT" "arial.ttf" 0 1 0 "_N" "_N")

or 

(entMake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 . "ArialT") '(70 . 0) '(40 . 1.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(3 . "arial.ttf") '(4 . "")))

No matter , is the same problem at the end . 

 

0 Likes
Message 18 of 61

Anonymous
Not applicable

Thank you very much  CADaStroumph .

 

Run the next code in a new drawing :

 

(defun c:TestPP ()
 (prinC "\n  TestPP  :  V  :  1 . 04 . 2019  ;")
 (setVar "TextStyle" "Standard")
;;; (if (tblSearch "Style" "ArialTopo") (setVar "TextStyle" "ArialTopo"))
 (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") ) ;
;;;(if (not (tblSearch "Style" "ArialT")) (entMake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 . "ArialT") '(70 . 0) '(40 . 1.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(3 . "arial.ttf") '(4 . ""))) )
  
   (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)

;;; (setVar "TextStyle" "ArialT")
 (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

delete ALL and run again .

 

This is the problem , the red attributes have a problem .

 

So , how it is working on the first time and not after ?

 

Regards ,

Costin

0 Likes
Message 19 of 61

CADaSchtroumpf
Advisor
Advisor

A priori in your code is the assignment of ArialT style when there is parity of the number that does not do well.
if you make an eattedit on an absent attribute and you go into the text options, no style is affected.

with the good style, the tag is come-back

0 Likes
Message 20 of 61

Moshe-A
Mentor
Mentor

consider dealing this with anonymous blocks (much the same as AutoCAD deals with dimensions) BATTMAN\ATTSYNC does not affect them. this means that each block reference (insert) will have it's own block definition and the dwg size would be increase accordingly.

 

 

 

0 Likes