Topic: my old routines that make my work easier...

[efernal]

Code: [Select]

;; wrote by Eduardo Fernal
;; target (generat a fas file to create a block, with or not attritubes)
;; fas files are VERYYYY SMALLER than DWG files...
;; As a developer, I must be fast...
;; So, I allways write routines to 'make' routines...

(DEFUN c:ssdxf (/ ent x s1 sn cn arq ent flag bloco linha1 linha2)
  (SETVAR "CMDECHO" 0)
  (SETQ s1 (SSGET))
  (IF s1
    (PROGN (SETQ sn   (SSLENGTH s1)
                 cn   0
                 flag 0
           )
           (REPEAT sn
             (SETQ ent (SSNAME s1 cn)
                   cn  (1+ cn)
             )
             (IF (= (CDR (ASSOC 0 (ENTGET ent))) "ATTDEF")
               (SETQ flag 2)
             )
           )
           (SETQ cn   0
                 flag (ITOA flag)
           )
           (INITGET "Sim Não Nao")
           ;; ask for saving in a file or not...
           (SETQ arq (GETKWORD "\n-> Salvar em Arquivo ou Não ? < Sim Não > : "))
           (IF (= arq "Sim")
             (PROGN (INITGET "Bloco Nao Não")
                    ;; want to generate a block, yes or no?
                    (SETQ bloco (GETKWORD "\n-> Deseja para Bloco? < Bloco Não > : "))
                    (IF (= bloco "Bloco")
                      ;; change SUBSTITUA (subst) at lsp created file...
                      (SETQ linha1 (STRCAT
                                     "(IF (NULL (TBLSEARCH \"BLOCK\" \"SUBSTITUA\"))"
                                     "  (PROGN\n" ;
                                     "    (ENTMAKE \n" ;
                                     "      '((0 . \"BLOCK\")\n"
                                     "        (2 . \"SUBSTITUA\")\n        (70 . " flag
                                     ")\n" "        (10 0.0 0.0 0.0)\n" ;
                                     "    )\n" "  )\n"
                                    )
                            linha2 (STRCAT "        (ENTMAKE '((0 . \"ENDBLK\")))" "  )\nnil)")
                      )
                      (SETQ linha1 nil
                            linha2 nil
                      )
                    )
                    ;; change the paths here (LIXO = GARBAGE)
                    (SETQ arq (OPEN "c:\\LIXO\\Dxf.lsp" "w"))
                    (IF linha1
                      (WRITE-LINE linha1 arq)
                    )
                    (ALERT "Salvo em C:\\LIXO\\DXF.LSP")
             )
             (SETQ arq nil)
           )
           (REPEAT sn
             (SETQ ent (SSNAME s1 cn)
                   cn  (1+ cn)
                   ent (ENTGET ent '("*"))
             )
             (IF (AND (/= (CDR (ASSOC 0 ent)) "3DSOLID") (/= (CDR (ASSOC 0 ent)) "HATCH"))
               (IF arq
                 (PROGN (IF (> cn 1)
                          (WRITE-LINE "\n))" arq)
                        )
                        (WRITE-LINE "(ENTMAKE '(" arq)
                        (FOREACH x ent
                          (IF (AND (/= (CAR x) -1)
                                   (/= (CAR x) 5)
                                   (/= (CAR x) 67)
                                   (/= (CAR x) 102)
                                   (/= (CAR x) 210)
                                   (/= (CAR x) 330)
                                   (/= (CAR x) 410)
                              )
                            (PRINT x arq)
                          )
                        )
                 )
                 (PROGN (PRINC "\n*****************************************************")
                        (FOREACH x ent (PRINT x))
                 )
               )
             )
           )
           (IF arq
             (PROGN (WRITE-LINE "\n))" arq)
                    (IF linha1
                      (WRITE-LINE linha2 arq)
                    )
                    (CLOSE arq)
             )
           )
    )
    (PRINC "\n-> Nada selecionado...")
  )
  (PRINC)
)


[efernal]

forgot an output example (formatted latter)...

Code: [Select]

(IF (NULL (TBLSEARCH "BLOCK" "SUBSTITUA"))
  (PROGN (ENTMAKE '((0 . "BLOCK") (2 . "SUBSTITUA") (70 . 0) (10 0.0 0.0 0.0)))
         (ENTMAKE '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbText")
                    (10 1946.85 1295.53 0.0)
                    (40 . 62.5)
                    (1 . "dfadf")
                    (50 . 0.0)
                    (41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)
                    (11 0.0 0.0 0.0)
                    (100 . "AcDbText")
                    (73 . 0)
                   )
         )
         (ENTMAKE '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbText")
                    (10 1946.85 1395.93 0.0)
                    (40 . 62.5)
                    (1 . "dfdaf")
                    (50 . 0.0)
                    (41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)
                    (11 0.0 0.0 0.0)
                    (100 . "AcDbText")
                    (73 . 0)
                   )
         )
         (ENTMAKE '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbText")
                    (10 1946.85 1496.33 0.0)
                    (40 . 62.5)
                    (1 . "dfa")
                    (50 . 0.0)
                    (41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)
                    (11 0.0 0.0 0.0)
                    (100 . "AcDbText")
                    (73 . 0)
                   )
         )
         (ENTMAKE '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbText")
                    (10 1946.85 1596.73 0.0)
                    (40 . 62.5)
                    (1 . "dfadf")
                    (50 . 0.0)
                    (41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)
                    (11 0.0 0.0 0.0)
                    (100 . "AcDbText")
                    (73 . 0)
                   )
         )
         (ENTMAKE '((0 . "TEXT")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbText")
                    (10 1946.85 1697.13 0.0)
                    (40 . 62.5)
                    (1 . "dfadfadf")
                    (50 . 0.0)
                    (41 . 1.0)
                    (51 . 0.0)
                    (7 . "Standard")
                    (71 . 0)
                    (72 . 0)
                    (11 0.0 0.0 0.0)
                    (100 . "AcDbText")
                    (73 . 0)
                   )
         )
         (ENTMAKE '((0 . "LWPOLYLINE")
                    (100 . "AcDbEntity")
                    (8 . "0")
                    (100 . "AcDbPolyline")
                    (90 . 4)
                    (70 . 1)
                    (43 . 0.0)
                    (38 . 0.0)
                    (39 . 0.0)
                    (10 1711.28 802.522)
                    (40 . 0.0)
                    (41 . 0.0)
                    (42 . 0.0)
                    (91 . 0)
                    (10 2417.98 802.522)
                    (40 . 0.0)
                    (41 . 0.0)
                    (42 . 0.0)
                    (91 . 0)
                    (10 2417.98 1687.72)
                    (40 . 0.0)
                    (41 . 0.0)
                    (42 . 0.0)
                    (91 . 0)
                    (10 1711.28 1687.72)
                    (40 . 0.0)
                    (41 . 0.0)
                    (42 . 0.0)
                    (91 . 0)
                   )
         )
         (ENTMAKE '((0 . "ENDBLK")))
  )
  nil
)



[CAB]

You may also be interested in this one:
http://www.theswamp.org/index.php?topic=31145