Jump to content

BlockAtt By LISP

dkkx3a

By dkkx3a
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

The Buzzard Veteran

The Buzzard

Posted
Posted
help me!!!

 

 

Are you being attacked by a mugger?

Shall I call the police?

 

You know it would help on your part to do a little explaining.

Are you trying to learn lisp or are you demanding it to fall in your lap.

Although you say please, It seems you expect it written for you.

You do not ask what it is you want to know.

Folks volunteer their time here.

Some effort on your part is not too much to ask for.

 

Heres a great place to start: http://www.afralisp.net/index.php

 

Here is one of my thread requests along the lines of what you want: http://www.cadtutor.net/forum/showthread.php?t=36793

 

Its a long thread so keep reading.

Link to comment
Share on other sites
The Buzzard Veteran

The Buzzard

Posted
Posted

Here is a code that makes a Left Swing Door block with an attribute.

The Layers are created with Entmake, The Font Style is also created with Entmake and the Block is made by way of Entmake.

 

This will give you an idea of what you need to do for your code.

 

Can I write your code? Yes

Will I write your code? No

 

That you will have to do.

If you ask questions about anything you do not understand, I will be happy to answer them.

 

Note: You can refer to AutoCAD's Developer Help Section to look up the functions used here. Also check out the DXF Reference. You will find explainations for everything in this code. Part of the learning process is doing the research.

 

Get working.

 

(defun C:LD (/ INPT AFAP AFAP01 ASAP ASAP01 BNAM INPT EXDR ASTY AWID ASIZ TLNAM WID THK
              PT01 PT02 PT03 PT04 SANG EANG BRPT)
 (setq ASTY  "Romans")
 (LD_FS ASTY)
 (setq AWID    1.0)
 (setq ASIZ    4.5)
 (setq TLNAM "A-DOOR-IDEN")
 (setq DLNAM "A-DOOR-FULL")
 (setq BNAM  "LDR")
 (setq BRPT (list 0.0 0.0 0.0))
 (setq EXDR (list 0.0 0.0 1.0))
 (setq WID 36.0)
 (setq THK  2.0)
 (LD_ML TLNAM 2 "Continuous" 35)
 (LD_ML DLNAM 3 "Continuous" 50)
 (if (null (tblsearch "block" BNAM))(LD_BD))

 (setq INPT (getpoint "\nGet insertion point:"))
 (setq AFAP   (polar INPT (DTR 270.0)      11.25))
 (setq AFAP01 (polar AFAP (DTR   0.0)      15.0))
 (setq ASAP   (polar INPT (DTR 270.0)       6.75))
 (setq ASAP01 (polar ASAP (DTR   0.0)(/ WID 2.0)))
 (entmake
   (list
     (cons 0   "INSERT")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8    DLNAM)    
     (cons 66   1)
     (cons 2    BNAM)
     (cons 10   INPT)
     (cons 41   1)
     (cons 42   1)
     (cons 50   0)
     (cons 43   1)
     (cons 70   0)
     (cons 71   0)
     (cons 44   0)
     (cons 45   0)
     (cons 210  EXDR)
     (cons 62   256)
     (cons 39   0)
     (cons 6   "BYLAYER")))
 (entmake
   (list
     (cons 0   "attrib")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8    TLNAM)
     (cons 10   AFAP01)
     (cons 40   ASIZ)
     (cons 1   "D01")
     (cons 2   "ID")
     (cons 70   
     (cons 73   0)
     (cons 50   0.0)
     (cons 41   AWID)
     (cons 51   0.0)
     (cons 7    ASTY)
     (cons 71   0)
     (cons 72   1)
     (cons 11   ASAP01)
     (cons 210  EXDR)
     (cons 74   2)))
 (entmake
   (list
     (cons 0   "SEQEND")
     (cons 8   "0")))
 (prompt "\nRotation Angle: ")
 (command "_.rotate" "last" "" INPT pause))
;Degrees to Radians
(defun DTR (a) (* pi (/ a 180.0)))
;Block Definition
(defun LD_BD ()
 (setq PT01 (polar BRPT (DTR  90.0) WID))
 (setq PT02 (polar PT01 (DTR   0.0) THK))
 (setq PT03 (polar PT02 (DTR 270.0) WID))
 (setq PT04 (polar PT03 (DTR 180.0) THK))
 (setq SANG   0.0)
 (setq EANG   1.5708)
 (setq AFAP   (polar BRPT (DTR 270.0)      11.25))
 (setq AFAP01 (polar AFAP (DTR   0.0)      15.0))
 (setq ASAP   (polar BRPT (DTR 270.0)       6.75))
 (setq ASAP01 (polar ASAP (DTR   0.0)(/ WID 2.0)))
 (entmake
   (list
     (cons 0   "block")
     (cons 2    BNAM)
     (cons 10   BRPT)
     (cons 70   2)))
 (entmake
   (list
     (cons 0   "LWPOLYLINE")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8   "0")
     (cons 100 "AcDbPolyline")
     (cons 90   4)
     (cons 70   1)
     (cons 43   0.0)
     (cons 38   0.0)
     (cons 39   0.0)
     (cons 10   PT01)
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   PT02)
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   PT03)
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   PT04)
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 210  EXDR)))
 (entmake
   (list
     (cons 0   "arc")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8   "0")
     (cons 100 "AcDbCircle")
     (cons 10   BRPT)
     (cons 39   0.0)
     (cons 40   WID)
     (cons 210  EXDR)
     (cons 100 "AcDbArc")
     (cons 50   SANG)
     (cons 51   EANG)))
 (entmake
   (list
     (cons 0   "attdef")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8    TLNAM)
     (cons 10   AFAP01)
     (cons 40   ASIZ)
     (cons 1   "D01")
     (cons 3   "Door ID:")
     (cons 2   "ID")
     (cons 70   
     (cons 73   0)
     (cons 50   0.0)
     (cons 41   AWID)
     (cons 51   0.0)
     (cons 7    ASTY)
     (cons 71   0)
     (cons 72   1)
     (cons 11   ASAP01)
     (cons 210  EXDR)
     (cons 74   2)))
 (entmake
   (list
     (cons 0   "endblk")
     (cons 8   "0"))))
;Make Layer
(defun LD_ML (LNAM LCLR LTYP LWGT)
 (if (null (tblsearch "layer" LNAM))
   (entmake
     (list
       (cons   0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons   2  LNAM)
       (cons  70  0)
       (cons  62  LCLR)
       (cons   6  LTYP)
       (cons 290  1)
       (cons 370  LWGT))))
 (princ))
;Font Style
(defun LD_FS (ASTY)
 (setq FSTY ASTY
       TWF 1.0
       TOA 0.0
       PFN "romans.shx"
       BFN "")
 (if (null (tblsearch "style" FSTY))
   (entmake
     (list
       (cons 0   "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2    FSTY)
       (cons 70   0)
       (cons 40   0)
       (cons 41   TWF)
       (cons 50   TOA)
       (cons 3    PFN)
       (cons 4    BFN))))
 (princ))

Link to comment
Share on other sites
fixo Mentor

fixo

Posted
Posted
Please help me make it by LISP, thanks.

 

You can start from the simplest way:

 

(defun C:MBL (/ clr col sset)
(command "._zoom" "_w" "-1.0,-1.0" "5,3");<-- zoom to desired limits (optional)
(setq clr (getvar "CLAYER"));<--store current layer
(setq col (getvar "CECOLOR"));<--store current layer color
(setvar "CMDECHO" 0); <-- turn command echo off 
(setvar "CLAYER" "0");<--set current layer "0"
(setvar "CECOLOR" "BYLAYER");<-- set color to bylayer  
(setq sset (ssadd));<-- create empty selection set
(command "._line" "_non" "0,0" "_non" "1.8182,0" "")
(ssadd (entlast) sset);<--append newly created entity to selection set
(command "._pline" "_non" "1.2121,0" "_w" "0" ".2424" "_non" "1.2121,0.7576"
   "_w" "0" "0" "_non" "1.2121,1.3636" "_non" "4.1818,1.3636" "")
(ssadd (entlast) sset);<--append newly created entity to selection set
(command "._-attdef" "_p" "" "LEVEL" "Level" "0.00" "_s" "DN_DCT"
 "_j" "BL" "1.2121,1.3636" "1.0" "0")
(ssadd (entlast) sset);<--append newly created entity to selection set
(command "._-block" "myBlockName" "_non" "0,0" sset "");<-- change block name here
(command "._erase" sset "")
(setvar "CMDECHO" 1); <-- turn command echo on   
(setvar "CLAYER" clr);<--restore current layer
(setvar "CECOLOR" col);<--restore current layer color  
 (princ)
 )
(princ "\n  >> Type MBL to cteate block  <<")
(prin1)

 

~'J'~

Link to comment
Share on other sites
The Buzzard Veteran

The Buzzard

Posted
Posted

Ok, I decided to write it.

Try this. I had to fix a flag issue, But it is now fixed.

Any changes to these lisps will require you to ask questions.

 

BLK123.lsp This lisp has no prompt for attribute value.

(defun C:BLK123 (/ BNAM BLKLNAM BRPT DSF INPT )
 (FS_123 "DN_DCT")
 (setq BLKLNAM "CTnhut")
 (ML_123 BLKLNAM 7 "Continuous")
 (setq BNAM  "123")
 (setq BRPT (list 0.0 0.0 0.0))
 (or D::SF (setq D::SF 1))
 (if (null (tblsearch "block" BNAM))(BD_123))
 (setq D::SF (cond ((getint (strcat "\nSpecify block scale factor <"(itoa D::SF)">: ")))(T D::SF)))                
 (setq DSF D::SF)
 (setq INPT (getpoint "\nInsertion point:"))
 (command "._-layer" "_S" BLKLNAM "")
 (command "._-insert" BNAM INPT DSF DSF pause)
 (princ))
(princ "\nType BLK123 to start.")
;Block Definition
(defun BD_123 ()
 (entmake
   (list
     (cons 0   "block")
     (cons 2    BNAM)
     (cons 10   BRPT)
     (cons 70   2)))
 (entmake
   (list
     (cons 0   "LWPOLYLINE")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8   "0")
     (cons 62   7)
     (cons 100 "AcDbPolyline")
     (cons 90   6)
     (cons 70   0)
     (cons 38   0.0)
     (cons 39   0.0)
     (cons 10   (list 0.0 0.0))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.81818 0.0))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.21212 0.0))
     (cons 40   0.0)
     (cons 41   0.242424)
     (cons 42   0.0)
     (cons 10   (list 1.21212 0.757576))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.21212 1.36364))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 4.18182 1.36364))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 210  (list 0.0 0.0 1.0))))
 (entmake
   (list
     (cons 0   "ATTDEF")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8    BLKLNAM)
     (cons 100 "AcDbText")
     (cons 10  (list 1.21212 1.61364 0.0))
     (cons 40   1.0)
     (cons 1   "0.00")
     (cons 50   0.0)
     (cons 41   1.0)
     (cons 51   0.0)
     (cons 7   "DN_DCT")
     (cons 71   0)
     (cons 72   0)
     (cons 11  (list 0.0 0.0 0.0))
     (cons 210 (list 0.0 0.0 1.0))
     (cons 100 "AcDbAttributeDefinition")
     (cons 3   "Value:")
     (cons 2   "VALUE")
     (cons 70   
     (cons 73   0)
     (cons 74   0)))
 (entmake
   (list
     (cons 0   "endblk")
     (cons 8   "0"))))
;Make Layer
(defun ML_123 (LNAM LCLR LTYP)
 (if (null (tblsearch "layer" LNAM))
   (entmake
     (list
       (cons   0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons   2  LNAM)
       (cons  70  0)
       (cons  62  LCLR)
       (cons   6  LTYP)
       (cons 290  1))))
 (princ))
;Font Style
(defun FS_123 (ASTY)
 (setq FSTY ASTY
       TWF 1.0
       TOA 0.0
       PFN "VNI-Helve-Condense.shx"
       BFN "")
 (if (null (tblsearch "style" FSTY))
   (entmake
     (list
       (cons 0   "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2    FSTY)
       (cons 70   0)
       (cons 40   0)
       (cons 41   TWF)
       (cons 50   TOA)
       (cons 3    PFN)
       (cons 4    BFN))))
 (princ))

 

 

BLK123-2.lsp This lisp prompts for attribute value.

(defun C:BLK123-2 (/ BNAM BLKLNAM BRPT DSF INPT )
 (FS_123 "DN_DCT")
 (setq BLKLNAM "CTnhut")
 (ML_123 BLKLNAM 7 "Continuous")
 (setq BNAM  "123")
 (setq BRPT (list 0.0 0.0 0.0))
 (or D::SF (setq D::SF 1))
 (if (null (tblsearch "block" BNAM))(BD_123))
 (setq D::SF (cond ((getint (strcat "\nSpecify block scale factor <"(itoa D::SF)">: ")))(T D::SF)))                
 (setq DSF D::SF)
 (setq INPT (getpoint "\nInsertion point:"))
 (command "._-layer" "_S" BLKLNAM "")
 (command "._-insert" BNAM INPT DSF DSF pause pause)
 (princ))
(princ "\nType BLK123-2 to start.")
;Block Definition
(defun BD_123 ()
 (entmake
   (list
     (cons 0   "block")
     (cons 2    BNAM)
     (cons 10   BRPT)
     (cons 70   2)))
 (entmake
   (list
     (cons 0   "LWPOLYLINE")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8   "0")
     (cons 62   7)
     (cons 100 "AcDbPolyline")
     (cons 90   6)
     (cons 70   0)
     (cons 38   0.0)
     (cons 39   0.0)
     (cons 10   (list 0.0 0.0))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.81818 0.0))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.21212 0.0))
     (cons 40   0.0)
     (cons 41   0.242424)
     (cons 42   0.0)
     (cons 10   (list 1.21212 0.757576))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 1.21212 1.36364))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 10   (list 4.18182 1.36364))
     (cons 40   0.0)
     (cons 41   0.0)
     (cons 42   0.0)
     (cons 210  (list 0.0 0.0 1.0))))
 (entmake
   (list
     (cons 0   "ATTDEF")
     (cons 100 "AcDbEntity")
     (cons 67   0)
     (cons 410 "Model")
     (cons 8    BLKLNAM)
     (cons 100 "AcDbText")
     (cons 10  (list 1.21212 1.61364 0.0))
     (cons 40   1.0)
     (cons 1   "0.00")
     (cons 50   0.0)
     (cons 41   1.0)
     (cons 51   0.0)
     (cons 7   "DN_DCT")
     (cons 71   0)
     (cons 72   0)
     (cons 11  (list 0.0 0.0 0.0))
     (cons 210 (list 0.0 0.0 1.0))
     (cons 100 "AcDbAttributeDefinition")
     (cons 3   "Value:")
     (cons 2   "VALUE")
     (cons 70   4)
     (cons 73   0)
     (cons 74   0)))
 (entmake
   (list
     (cons 0   "endblk")
     (cons 8   "0"))))
;Make Layer
(defun ML_123 (LNAM LCLR LTYP)
 (if (null (tblsearch "layer" LNAM))
   (entmake
     (list
       (cons   0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons   2  LNAM)
       (cons  70  0)
       (cons  62  LCLR)
       (cons   6  LTYP)
       (cons 290  1))))
 (princ))
;Font Style
(defun FS_123 (ASTY)
 (setq FSTY ASTY
       TWF 1.0
       TOA 0.0
       PFN "VNI-Helve-Condense.shx"
       BFN "")
 (if (null (tblsearch "style" FSTY))
   (entmake
     (list
       (cons 0   "STYLE")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbTextStyleTableRecord")
       (cons 2    FSTY)
       (cons 70   0)
       (cons 40   0)
       (cons 41   TWF)
       (cons 50   TOA)
       (cons 3    PFN)
       (cons 4    BFN))))
 (princ))

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...