autolisp

Default lisp to calculate total areas

لو عندي مجموعة مربعات وعايز احسب مساحاتهم كلهم

ياترى فيه ليسب يعمل الكلام دا

متابعة قراءة “Default lisp to calculate total areas”

AUTOCAD · autolisp · LISP

AutoCAD x,y, coordinates lisp command

بضعط الماوس يقولم الليسب بكتابة الاحداثيات

النسح الكلام التالي

(defun err (s)
  (if (/= s “Function cancelled”)
    (princ (strcat “\nError: ” s))
  )
  (errestore)
)
(defun errinit ()
  (setq olderr *error* 
        *error* err
        DT (getvar “dimtad”)                      ;Save DIMTAD
        AB (getvar “angbase”)                     ;Save ANGBASE
        AD (getvar “angdir”)                      ;Save ANGDIR
  )
  (setvar “dimtad” 0)                             ;Set DIMTAD = 0
  (setvar “angbase” 0)                            ;Set ANGBASE = 0
  (setvar “angdir” 0)                             ;Set ANGDIR = 0
)
(defun errestore ()
  (setvar “dimtad” DT)                            ;Restore DIMTAD
  (setvar “angbase” AB)                           ;Restore ANGBASE
  (setvar “angdir” AD)                            ;Restore ANGDIR
  (setq *error* olderr) 
  (princ)
)
(defun c:xY (/ olderr DT AB AD olddflt dflt prmpt pnt etxt ntxt ctxt
                   ename ent txtpnt txthgt txtjst)
  (errinit)
  
  (setq dflt “2-lines”
        prmpt (strcat “\n  <” dflt “>/1-line/: “))
  (initget “2-lines 1-line”)
  (while (setq pnt (getpoint prmpt))
    (if (/= (type pnt) ‘LIST)
      (progn
        (setq olddflt dflt dflt pnt)
        (if (= dflt “Undo”)
          (progn
            (command “u”)
            (setq dflt olddflt)
          );end progn
        );end if
      );end progn
      (progn
        (command “undo” “group”)
        (if (= dflt “2-lines”)
          (progn
            (setq etxt (strcat (rtos (car pnt) 2 3) ” D”)
                  ntxt (strcat (rtos (cadr pnt) 2 3) ” L”)
            );end setq
            (setvar “texteval” 1)
            (if (= (substr (getvar “acadver”) 1 2) “12”)
              (progn
                (command “dim1” “leader” pnt pause “” etxt)
                (setvar “texteval” 0)
                (setq ename (entlast)
                        ent (entget ename)
                     txtpnt (cdr (assoc 11 ent))
                     txthgt (cdr (assoc 40 ent))
                );end setq
                (if (= (cdr (assoc 72 ent)) 0)(setq txtjst “ml”)(setq txtjst “mr”))
                (setvar “texteval” 1)
                (command “text” txtjst txtpnt txthgt 0 “”)
                (command “text” “” ntxt)
              );end progn
              (command “leader” pnt pause “” etxt ntxt “”)
            );end if
            (setvar “texteval” 0)
          );end progn
        );end if
        (if (= dflt “1-line”)
          (progn
            (setq ctxt (strcat (rtos (car pnt) 2 3) ” D, ” (rtos (cadr pnt) 2 3) ” L”))
            (setvar “texteval” 1)
            (if (= (substr (getvar “acadver”) 1 2) “12”)
              (command “dim1” “leader” pnt pause “” ctxt)
              (command “leader” pnt pause “” ctxt “”)
            );end if
            (setvar “texteval” 0)
          );end progn
        );end if
        (command “undo” “end”)
      );end progn
    );end if
    (cond ((= dflt “2-lines”) (setq prmpt (strcat “\n  <” dflt “>/1-line/Undo/: “)))
          (T                  (setq prmpt (strcat “\n  <” dflt “>/2-lines/Undo/: “)))
    );end cond
    (initget “2-lines 1-line Undo”)
  );end while
  
  (errestore)
);end defun

افتحNotepad –>

الصق ما نسختة

احفظ الملف  xy.ls

 (in the file type, select All Files)

From Autocad –> Tools –> Load Application –> select this file –> Close

Tip: if required this application in every drawing, contents –> Add –> Select file –> Add — Close –> Close.

في command line اكتب 

XY –>

اختر النقطة

AUTOCAD · autolisp

Auto-number Attributes

ترقيم البلوكات في الاتوكاد بطريقة تلقائية

Automatically Label Attributes

Function Syntax -None-
Current Version 1.0
Download AutoLabelAttributesV1-0.lsp
View HTML Version AutoLabelAttributesV1-0.html

AutoLabel.gif

ليسب اخر   http://www.cadstudio.cz/en/download.asp?file=InsertC

Free applications and CAD utilities (mostly our freeware)
CAD Utilities
Download InsertC + BlockC – insert new (or renumber existing) blocks with incrementing numbers in attributes (incremental numbering, counter)

صيغة  اخري الليسب

(defun c:mnum(/ stStr stNum nLen cAtr dLst blName
fLst blLst blSet aName sLst lZer aStr)
(vl-load-com)
(if
(and
(setq stStr(getstring “\nSpecify start number: “))
(setq stNum(atoi stStr))
(setq nLen(strlen stStr))
); end and
(progn
(if
(and
(setq cAtr(nentsel “\nPick attribute > “))
(= “ATTRIB”(cdr(assoc 0(setq dLst(entget(car cAtr))))))
); end and
(progn
(setq blName
(vla-get-Name
(vla-ObjectIDToObject
(vla-get-ActiveDocument
(vlax-get-acad-object))
(vla-get-OwnerID
(vlax-ename->vla-object(car cAtr)))))
fLst(list ‘(0 . “INSERT”)(cons 2 blName))
aName(cdr(assoc 2 dLst))
); end setq
(princ “\n<<< Select blocks to number >>> “)
(if
(setq blSet(ssget fLst))
(progn
(setq sLst
(mapcar ‘vlax-ename->vla-object
(mapcar ‘car
(vl-sort
(vl-sort
(mapcar ‘(lambda(x)(list x(cdr(assoc 10(entget x)))))
(vl-remove-if ‘listp
(mapcar ‘cadr(ssnamex blSet))))
‘(lambda(a b)(<(caadr a)(caadr b))))
‘(lambda(a b)(>(cadadr a)(cadadr b)))))))
(foreach i sLst
(setq lZer “”)
(repeat(- nLen(strlen(itoa stNum)))
(setq lZer(strcat lZer “0”))
); end repeat
(setq atLst
(vlax-safearray->list
(vlax-variant-value
(vla-GetAttributes i))))
(foreach a atLst
(if
(= aName(vla-get-TagString a))
(vla-put-TextString a
(strcat lZer(itoa stNum)))
); end if
); end foreach
(setq stNum(1+ stNum))
); end foreach
); end progn
(princ “\nEmpty selection! Quit. “)
); end if
); end progn
(princ “\nThis isn’t attribute! Quit. “)
); end if
); end progn
(princ “\nInvalid start number! Quit. “)
); end if
(princ)
); end of c:mnum

autolisp · HVAC

ليسبات جاهزه

وياريت لو في ليسبات جاهزه خاصة في التكييف نحملها علي طول ياريت لو ترفعهالنا وشكرا مقدما 🙂

http://forums.augi.com/showthread.php?83572-RADIUS-ELBOW-(HVAC-DUCTWORK-LSP)

متابعة قراءة “ليسبات جاهزه”

AUTOCAD · autodesk · autolisp

AutoLISP: Add length annotations to objects

 

ليسبات  AUTOLISP

لكتابة المعلومات على خطوطك

measure drawing

download Length at Midpoint program here.

 

تحميل مجاني MidLenV1-0.lsp

اكتب الطول على

Arcs, Circles, Lines, LWPolylines, 2D & 3D Polylines

متقولش للمدير عليه و خلص شغلك بدري

Length at Midpoint Demo

AUTOCAD · autolisp · OPEN SOURCE

ادراج PDF في لوحة الاتوكاد

برنامج مفتوح المصدر و مجاني

sourceforge.net/projects/vectpdf/?source=directory

 

 

Toolbar Button