صفحة 1 من 2 12 الأخيرةالأخيرة
النتائج 1 إلى 10 من 11

الموضوع: طلب ليسب ادراج بلوك عند عدة نقط

           
   
  1. #1

    طلب ليسب ادراج بلوك عند عدة نقط

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


    وجدت ليسب يعمل الخطوتين الاولى والثانية
    فهل يمكن ادراج الخطوة الثاثة

    وجزاكم الله خيرا

    اللسب الذي وجدته

    (defun c:RPWB (/ *error* _blocks lst block ss space)
    ;; Replace Points With Block
    ;; Alan J. Thompson, 08.23.11
    ;; Required subroutine: AT:ListSelect

    (vl-load-com)

    (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
    (princ (strcat "\nError: " msg))
    )
    )

    (defun _blocks (doc / l)
    (vlax-for x (vla-get-blocks doc)
    (if (not (wcmatch (vla-get-name x) "*|*,`**"))
    (setq l (cons (vla-get-name x) l))
    )
    )
    (vl-sort l '<)
    )

    (vla-startundomark
    (cond (*AcadDoc*)
    ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
    )

    (cond ((not (setq lst (_blocks *AcadDoc*))) (alert "Zero blocks in active drawing!"))
    ((and (setq block (car (AT:ListSelect "Select block to insert:" "" 10 10 "false" lst)))
    (princ "\nSelect POINT objects to replace: ")
    (ssget "_:L" '((0 . "POINT")))
    )

    (setq space (vlax-get-property
    *AcadDoc*
    (if (eq (getvar 'CVPORT) 1)
    'PaperSpace
    'ModelSpace
    )
    )
    )

    (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
    (if (vla-insertblock space (vla-get-coordinates x) block 1. 1. 1. 0.)
    (vla-delete x)
    )
    )

    (vla-delete ss)
    )
    )
    (*error* nil)
    (princ)
    )




    (defun AT:ListSelect (title label height width multi lst / fn fo d item f)
    ;; List Select Dialog (Temp DCL list box selection, based on provided list)
    ;; title - list box title
    ;; label - label for list box
    ;; height - height of box
    ;; width - width of box
    ;; multi - selection method ["true": multiple, "false": single]
    ;; lst - list of strings to place in list box
    ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
    (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
    (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
    (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
    (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
    (strcat "width = " (vl-princ-to-string width) ";")
    (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
    )
    (write-line x fo)
    )
    (close fo)
    (new_dialog "list_select" (setq d (load_dialog fn)))
    (start_list "lst")
    (mapcar (function add_list) lst)
    (end_list)
    (setq item (set_tile "lst" "0"))
    (action_tile "lst" "(setq item $value)")
    (setq f (start_dialog))
    (unload_dialog d)
    (vl-file-delete fn)
    (if (= f 1)
    ((lambda (s / i s l)
    (while (setq i (vl-string-search " " s))
    (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
    (setq s (substr s (+ 2 i)))
    )
    (reverse (cons (nth (atoi s) lst) l))
    )
    item
    )
    )
    )

  2. #2
    السلام عليك

    تم التعديل المطلوب
    و ايضا يوجد تعديل اضافى ان اردت ان تتحكم في نسبة تكبير البلوك

    - التعديل المطلوب
    شفرة:
    (defun c:RPWB (/ *error* _blocks lst block ss space)  ;; Replace Points With Block
      ;; Alan J. Thompson, 08.23.11
      ;; Required subroutine: AT:ListSelect
    
    
      (vl-load-com)
    
    
      (defun *error* (msg)
        (and *AcadDoc* (vla-endundomark *AcadDoc*))
        (if    (and msg
             (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
        )
          (princ (strcat "\nError: " msg))
        )
      )
    
    
      (defun _blocks (doc / l)
        (vlax-for x    (vla-get-blocks doc)
          (if (not (wcmatch (vla-get-name x) "*|*,`**"))
        (setq l (cons (vla-get-name x) l))
          )
        )
        (vl-sort l '<)
      )
    
    
      (vla-startundomark (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))) )))
    
    
      (cond    ((not (setq lst (_blocks *AcadDoc*)))
         (alert "Zero blocks in active drawing!")
        )
        ((and (setq block (car (AT:ListSelect
                     "Select block to insert:"
                     ""          10
                     10          "false"
                     lst
                    )
                  )
              )
              (princ "\nSelect POINT objects to replace: ")
              (ssget "_:L" '((0 . "POINT")))
              (setq rot (* pi (/ (getreal "\nWhat is Blocks rotation? ") 180.0)))
              )
    
    
         (setq space (vlax-get-property
                   *AcadDoc*
                   (if (eq (getvar 'CVPORT) 1)
                 'PaperSpace
                 'ModelSpace
                   )
                 )
         )
    
    
         (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
           (if (vla-insertblock
             space
             (vla-get-coordinates x)
             block
             1.
             1.
             1.
             rot
               )
             (vla-delete x)
           )
         )
    
    
         (vla-delete ss)
        )
      )
      (*error* nil)
      (princ)
    )
    
    
    
    
    
    
    
    
    (defun AT:ListSelect
           (title label height width multi lst / fn fo d item f)
      ;; List Select Dialog (Temp DCL list box selection, based on provided list)
      ;; title - list box title
      ;; label - label for list box
      ;; height - height of box
      ;; width - width of box
      ;; multi - selection method ["true": multiple, "false": single]
      ;; lst - list of strings to place in list box
      ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
      (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
      (foreach x (list (strcat "list_select : dialog { label = \""
                   title
                   "\"; spacer;"
               )
               (strcat ": list_box { label = \""
                   label
                   "\";"
                   "key = \"lst\";"
               )
               (strcat "allow_accept = true; height = "
                   (vl-princ-to-string height)
                   ";"
               )
               (strcat "width = " (vl-princ-to-string width) ";")
               (strcat "multiple_select = "
                   multi
                   "; } spacer; ok_cancel; }"
               )
             )
        (write-line x fo)
      )
      (close fo)
      (new_dialog "list_select" (setq d (load_dialog fn)))
      (start_list "lst")
      (mapcar (function add_list) lst)
      (end_list)
      (setq item (set_tile "lst" "0"))
      (action_tile "lst" "(setq item $value)")
      (setq f (start_dialog))
      (unload_dialog d)
      (vl-file-delete fn)
      (if (= f 1)
        ((lambda (s / i s l)
           (while (setq i (vl-string-search " " s))
         (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
         (setq s (substr s (+ 2 i)))
           )
           (reverse (cons (nth (atoi s) lst) l))
         )
          item
        )
      )
    )
    - التعديل مع امكانية التحكم في نسبة تكبير البلوك
    شفرة:
    (defun c:RPWB (/ *error* _blocks lst block ss space)  ;; Replace Points With Block
      ;; Alan J. Thompson, 08.23.11
      ;; Required subroutine: AT:ListSelect
    
    
      (vl-load-com)
    
    
      (defun *error* (msg)
        (and *AcadDoc* (vla-endundomark *AcadDoc*))
        (if    (and msg
             (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
        )
          (princ (strcat "\nError: " msg))
        )
      )
    
    
      (defun _blocks (doc / l)
        (vlax-for x    (vla-get-blocks doc)
          (if (not (wcmatch (vla-get-name x) "*|*,`**"))
        (setq l (cons (vla-get-name x) l))
          )
        )
        (vl-sort l '<)
      )
    
    
      (vla-startundomark (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))) )))
    
    
      (cond    ((not (setq lst (_blocks *AcadDoc*)))
         (alert "Zero blocks in active drawing!")
        )
        ((and (setq block (car (AT:ListSelect
                     "Select block to insert:"
                     ""          10
                     10          "false"
                     lst
                    )
                  )
              )
              (princ "\nSelect POINT objects to replace: ")
              (ssget "_:L" '((0 . "POINT")))
              (setq scl (getreal "\nWhat is Blocks scale? "))          
              (setq rot (* pi (/ (getreal "\nWhat is Blocks rotation? ") 180.0)))
              )
    
    
         (setq space (vlax-get-property
                   *AcadDoc*
                   (if (eq (getvar 'CVPORT) 1)
                 'PaperSpace
                 'ModelSpace
                   )
                 )
         )
    
    
         (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
           (if (vla-insertblock
             space
             (vla-get-coordinates x)
             block
             scl
             scl
             scl
             rot
               )
             (vla-delete x)
           )
         )
    
    
         (vla-delete ss)
        )
      )
      (*error* nil)
      (princ)
    )
    
    
    
    
    
    
    
    
    (defun AT:ListSelect
           (title label height width multi lst / fn fo d item f)
      ;; List Select Dialog (Temp DCL list box selection, based on provided list)
      ;; title - list box title
      ;; label - label for list box
      ;; height - height of box
      ;; width - width of box
      ;; multi - selection method ["true": multiple, "false": single]
      ;; lst - list of strings to place in list box
      ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
      (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
      (foreach x (list (strcat "list_select : dialog { label = \""
                   title
                   "\"; spacer;"
               )
               (strcat ": list_box { label = \""
                   label
                   "\";"
                   "key = \"lst\";"
               )
               (strcat "allow_accept = true; height = "
                   (vl-princ-to-string height)
                   ";"
               )
               (strcat "width = " (vl-princ-to-string width) ";")
               (strcat "multiple_select = "
                   multi
                   "; } spacer; ok_cancel; }"
               )
             )
        (write-line x fo)
      )
      (close fo)
      (new_dialog "list_select" (setq d (load_dialog fn)))
      (start_list "lst")
      (mapcar (function add_list) lst)
      (end_list)
      (setq item (set_tile "lst" "0"))
      (action_tile "lst" "(setq item $value)")
      (setq f (start_dialog))
      (unload_dialog d)
      (vl-file-delete fn)
      (if (= f 1)
        ((lambda (s / i s l)
           (while (setq i (vl-string-search " " s))
         (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
         (setq s (substr s (+ 2 i)))
           )
           (reverse (cons (nth (atoi s) lst) l))
         )
          item
        )
      )
    )
    أوتوكاد 2014
    فوتوشوب 8

    قال الشافعي رحمه الله
    " آمنت بالله و بما جاء عن الله على مراد الله
    و آمنت برسول الله و بما جاء عن رسول الله على مراد رسول الله "

  3. #3
    سلامات

    حمل اللسب من الرابط التالي و البرنامج كله من تصميمي و لاجل ذلك تأخرت بكتابته .

    امر تشغيل اللسب هو نفس اسم المجلد : ReplacingPts

    http://www.mediafire.com/?tozvaaoposbgvr7

    أعطني رأيك باللسب .

    تحياتي



    AutoLISP Writer / Syria , Abu Dhabi

  4. #4
    اقتباس المشاركة الأصلية كتبت بواسطة حسن العسوس مشاهدة المشاركة
    السلام عليك

    تم التعديل المطلوب
    و ايضا يوجد تعديل اضافى ان اردت ان تتحكم في نسبة تكبير البلوك
    ما هي النتيجه اذا المستخدم قام بالضغط على انتر و لم يدخل اي رقم ؟



    AutoLISP Writer / Syria , Abu Dhabi

  5. #5
    جزاك الله خيرا اخي حسن
    ممتاز الله يوفقك

  6. #6
    اقتباس المشاركة الأصلية كتبت بواسطة Tharwat مشاهدة المشاركة
    سلامات

    حمل اللسب من الرابط التالي و البرنامج كله من تصميمي و لاجل ذلك تأخرت بكتابته .

    امر تشغيل اللسب هو نفس اسم المجلد : ReplacingPts

    http://www.mediafire.com/?tozvaaoposbgvr7

    أعطني رأيك باللسب .

    تحياتي
    والله مشكور يا اخ ثروت عرفت انه عندما تاخر الرد ان هناك مفاجئة جميلة منك
    اللسب ممتاز وروعة هذه الطريقة تسهل عمليات الادخال
    امر غير مهم كثيرا ولكن يعطي البرنامج ميزات اخرى
    هو لو ممكن اضافة خيار حذف او الابقاء على النقط
    الان هو يحذف النقط المختارة بعد ادراج البلوك

  7. #7
    اخ ثروت امر التنفيذ ليس نفس اسم الملف
    الامر هو REPLACEPTS
    جربت اللسب في ملفين الاول عمل تمام تحت الامر REPLACEPTS
    الملف الاخر لم يعمل ويعطي رسالة خطا
    Command: REPLACEPTS
    ; error: bad argument type: VLA-OBJECT nil
    اه
    الان وانا اكتب المشاركة اكتشفت حاجة
    عندما لم يعمل اللسب الذي عملته جربت لسب الاول الذي عدله الاخ حسن بعد ظهور نافذة اختيار البلوك اغلقتها وقلت ساجرب الان ليسب الاخ ثروت
    عند التجريب اشتغل تمام

    هل عرفت المشلكة اخ ثروت ؟
    اي انه عندما حمل اللسب خاصتك اول لم يعمل ولكن بعد ان حملت ليسب الاخ حسن عاد اللسب خاصتك للعمل

  8. #8
    كلامك صحيح اخ خالد , بالاول كنت قد نسيت اضافه ميزه الرجوع عن العمل و عند الاضافه نسيت وضع كود معين و لكنني غيرتها مباشرة و بسرعه
    و لكن الظاهر انك كنت الاسرع في تحميل النسخه الاولى من بعد كم دقيقه من رفع الملف , على كل حال قم بتنزيل النسخه الموجوده بالرابط السابق
    و احذف النسخه الموجوده عندك لكي لا تتضارب الملفات مع بعضها على كمبيوترك ( لك حرية الاختيار ) .

    - طالما اردت اضافه ميزة حذف النقاط ام لا , فأنتظر بعض الوقت لكي اضيف لك التعديل المطلوب و تأخذ النسخه المطوره الاخيره .

    تحياتي



    AutoLISP Writer / Syria , Abu Dhabi

  9. #9
    سلامات

    جرب اللسب الان على الرابط التالي :

    http://www.mediafire.com/?29mww82m5tc5844

    رأيك يهمنا بالموضوع .

    تحياتي

    ثروت



    AutoLISP Writer / Syria , Abu Dhabi

  10. #10
    اقتباس المشاركة الأصلية كتبت بواسطة Tharwat مشاهدة المشاركة
    سلامات

    جرب اللسب الان على الرابط التالي :

    http://www.mediafire.com/?29mww82m5tc5844

    رأيك يهمنا بالموضوع .

    تحياتي

    ثروت
    ما قصرت اخي ثروت
    ممتاز الله يبارك لك في علمك

الكلمات الدلالية لهذا الموضوع

مواقع المفضلات الاجتماعية

مواقع المفضلات الاجتماعية

ضوابط المشاركة

  • لا تستطيع إضافة مواضيع جديدة
  • لا تستطيع الرد على المواضيع
  • لا تستطيع إرفاق ملفات
  • لا تستطيع تعديل مشاركاتك
  •