النتائج 1 إلى 4 من 4

الموضوع: تعديل ليسب ليستخرج الإحداثيات من أوتوكاد في إكسل!

           
   
  1. #1

    تعديل ليسب ليستخرج الإحداثيات من أوتوكاد في إكسل!

    الى خبراء الليسب من يستطيع ان يعدل لي هذا الليسب
    اسم الليسب pt ويستخدم لاستخراج الاحداثيات من الاوتوكاد الى الاكسل او اي ملف اخر خارجي
    مع ارقامها على الرسم وفي الملف على الشكل التالي PT E N
    ولكن اريد ان يضاف الى الاحداثيات ال Z اي على الشكل التالي

    PT E N Z
    ولكم جزيل الشكر
    وهذا هو الليسب
    شفرة:
    (defun derr (s) ; If an error (such as CTRL-C) occurs
     ; while this command is active...
     (if (/= s "Function cancelled")
     (princ (strcat "\n*Error: " s))
     )
     (setvar "cmdecho" echo)
     (setvar "blipmode" blip)
     (setvar "luprec" decimal)
     (setq *error* olderr) ; Restore old *error* handler
     (close file)
     (princ)
    )
    ;----------------------------------------------------------------------------
    (defun c:pt()
     
     (setq olderr *error*
     *error* derr)
     (setq echo (getvar "cmdecho"))
     (setq blip (getvar "blipmode"))
     (setq decimal (getvar "luprec"))
     (setvar "cmdecho" 0)
     (setvar "blipmode" 0)
     
     (setq pt_file (getstring "\nPoints File Name <points.txt>:"))
     (if (= pt_file "")
     (setq file (open "points.txt" "w"))
     (setq file (open pt_file "w"))
     )
     (setq h-scale (getint "\nHorizontal Scale 1:"))
     (setq pre_code (getstring "\nPrefix Code:"))
     (setq start_pn (getint "\nStart Number:"))
     
     (setq pn start_pn)
     (setq hs-factor (/ h-scale 100))
     (setq p 0)
     (setq n 1)
     (while p
     (setq p (getpoint "\nSelect Point <Exit>:"))
     (if p
     (progn
     (setq str_pn (itoa pn))
     (setq pt_code (strcat pre_code str_pn))
     (setq ptxt (list
     (- (car p) (* 0.5 hs-factor))
     (+ (cadr p) (* 0.5 hs-factor))
     ))
     
     (command "point" p)
     (command "text" "m" ptxt "0" pt_code)
     
     ;Writting Selected point to the file
     ;-----------------------------------
     (princ (strcat "\n" pt_code " " (rtos (car p)) " " 
     (rtos (cadr p)) ) file)
     (setq pn (+ pn 1))
     
     (setq pt_list1 (list (append (list pt_code) p)))
     (if (= n 1)
     (setq pt_list pt_list1)
     (setq pt_list (append pt_list pt_list1))
     )
     (setq n (+ n 1))
     )
     )
     )
    
     (prompt "\n** Points Coordinates Table **")
     
     (setq p_l_up (getpoint "\nSelect Upper Left Cornner :\n"))
     (setq p_r_up (list (+ (car p_l_up) (* 7.2 hs-factor))
     (cadr p_l_up) ))
     (setq ph1 (list (car P_l_up)
     (- (cadr p_l_up) (* 1 hs-factor)) ))
     (setq ph2 (list (car P_r_up)
     (- (cadr p_r_up) (* 1 hs-factor)) ))
    
     (setq ph_txt1 (list (+ (car p_l_up) (* 0.6 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
     (setq ph_txt2 (list (+ (car p_l_up) (* 2.7 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
     (setq ph_txt3 (list (+ (car p_l_up) (* 5.7 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
    
     (command "line" p_l_up p_r_up "")
     (command "line" ph1 ph2 "")
     (command "text" "m" ph_txt1 "0" "Pt.")
     (command "text" "m" ph_txt2 "0" "X")
     (command "text" "m" ph_txt3 "0" "Y")
     
     (setq len_ptlst (length pt_list))
     (setq n_lst 0)
     (repeat len_ptlst
     (progn
     (setq p1 (list (car ph1)
     (- (cadr ph1) (* 1 (+ n_lst 1) hs-factor)) ))
    
     (setq p2 (list (car ph2)
     (- (cadr ph2) (* 1 (+ n_lst 1) hs-factor)) ))
     
     (setq ptxt1 (list 
     (car ph_txt1)
     (- (cadr ph_txt1)(* 1 (+ n_lst 1) hs-factor)) ))
     (setq ptxt2 (list 
     (car ph_txt2)
     (- (cadr ph_txt2)(* 1 (+ n_lst 1) hs-factor)) ))
     (setq ptxt3 (list 
     (car ph_txt3)
     (- (cadr ph_txt3)(* 1 (+ n_lst 1) hs-factor)) ))
    
     (setq x (rtos (nth 1 (nth n_lst pt_list))))
     (setq y (rtos (nth 2 (nth n_lst pt_list))))
     
     (princ (strcat "\rPoint Number " (nth 0 (nth n_lst pt_list))))
     (command "text" "m" ptxt1 "0" (nth 0 (nth n_lst pt_list)))
     (command "text" "m" ptxt2 "0" x)
     (command "text" "m" ptxt3 "0" y)
     (command "line" p1 p2 "")
     
     )
     (setq n_lst (+ n_lst 1))
     )
     
     (setq pv1 (list (+ (car p_l_up) (* 1.2 hs-factor))
     (cadr p_l_up) ))
     (setq pv2 (list (+ (car p_l_up) (* 4.2 hs-factor))
     (cadr p_l_up) ))
     (setq pv3 (list (+ (car p1) (* 1.2 hs-factor))
     (cadr p1) ))
     (setq pv4 (list (+ (car p1) (* 4.2 hs-factor))
     (cadr p1) ))
    
     (command "line" p_l_up p1 "")
     (command "line" pv1 pv3 "")
     (command "line" pv2 pv4 "")
     (command "line" p_r_up p2 "")
    
     (setvar "cmdecho" echo)
     (setvar "blipmode" blip)
     (setvar "luprec" decimal)
     (setq *error* olderr) ; Restore old *error* handler
     (close file)
     (princ)
    )

  2. #2

    اعطني الليسب الصحيح

    اعطني الليسب الصحيح الذي يعمل بشكل جيد ويخرج احداثيات
    E,N
    وسأحاول اضافة الاحداثي الثالث اليه

    لكني جربت الليسبلم يعمل جيدا

  3. #3

    اعطني الليسب الصحيح

    اعطني الليسب الصحيح الذي يعمل بشكل جيد ويخرج احداثيات
    E,N
    وسأحاول اضافة الاحداثي الثالث اليه

    لكني جربت الليسب لم يعمل جيدا

  4. #4

    هذا هو الليسب

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

    وهذا هو من جديد
    --------------------------------------------------------------------------------

    شفرة:
    (defun c:pt()
     
     (setq olderr *error*
     *error* derr)
     (setq echo (getvar "cmdecho"))
     (setq blip (getvar "blipmode"))
     (setq decimal (getvar "luprec"))
     (setvar "cmdecho" 0)
     (setvar "blipmode" 0)
     
     (setq pt_file (getstring "\nPoints File Name <points.txt>:"))
     (if (= pt_file "")
     (setq file (open "points.txt" "w"))
     (setq file (open pt_file "w"))
     )
     (setq h-scale (getint "\nHorizontal Scale 1:"))
     (setq pre_code (getstring "\nPrefix Code:"))
     (setq start_pn (getint "\nStart Number:"))
     
     (setq pn start_pn)
     (setq hs-factor (/ h-scale 100))
     (setq p 0)
     (setq n 1)
     (while p
     (setq p (getpoint "\nSelect Point <Exit>:"))
     (if p
     (progn
     (setq str_pn (itoa pn))
     (setq pt_code (strcat pre_code str_pn))
     (setq ptxt (list
     (- (car p) (* 0.5 hs-factor))
     (+ (cadr p) (* 0.5 hs-factor))
     ))
     
     (command "point" p)
     (command "text" "m" ptxt "0" pt_code)
     
     ;Writting Selected point to the file
     ;-----------------------------------
     (princ (strcat "\n" pt_code " " (rtos (car p)) " " 
     (rtos (cadr p)) ) file)
     (setq pn (+ pn 1))
     
     (setq pt_list1 (list (append (list pt_code) p)))
     (if (= n 1)
     (setq pt_list pt_list1)
     (setq pt_list (append pt_list pt_list1))
     )
     (setq n (+ n 1))
     )
     )
     )
    
     (prompt "\n** Points Coordinates Table **")
     
     (setq p_l_up (getpoint "\nSelect Upper Left Cornner :\n"))
     (setq p_r_up (list (+ (car p_l_up) (* 7.2 hs-factor))
     (cadr p_l_up) ))
     (setq ph1 (list (car P_l_up)
     (- (cadr p_l_up) (* 1 hs-factor)) ))
     (setq ph2 (list (car P_r_up)
     (- (cadr p_r_up) (* 1 hs-factor)) ))
    
     (setq ph_txt1 (list (+ (car p_l_up) (* 0.6 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
     (setq ph_txt2 (list (+ (car p_l_up) (* 2.7 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
     (setq ph_txt3 (list (+ (car p_l_up) (* 5.7 hs-factor))
     (- (cadr p_l_up) (* 0.5 hs-factor)) ))
    
     (command "line" p_l_up p_r_up "")
     (command "line" ph1 ph2 "")
     (command "text" "m" ph_txt1 "0" "Pt.")
     (command "text" "m" ph_txt2 "0" "X")
     (command "text" "m" ph_txt3 "0" "Y")
     
     (setq len_ptlst (length pt_list))
     (setq n_lst 0)
     (repeat len_ptlst
     (progn
     (setq p1 (list (car ph1)
     (- (cadr ph1) (* 1 (+ n_lst 1) hs-factor)) ))
    
     (setq p2 (list (car ph2)
     (- (cadr ph2) (* 1 (+ n_lst 1) hs-factor)) ))
     
     (setq ptxt1 (list 
     (car ph_txt1)
     (- (cadr ph_txt1)(* 1 (+ n_lst 1) hs-factor)) ))
     (setq ptxt2 (list 
     (car ph_txt2)
     (- (cadr ph_txt2)(* 1 (+ n_lst 1) hs-factor)) ))
     (setq ptxt3 (list 
     (car ph_txt3)
     (- (cadr ph_txt3)(* 1 (+ n_lst 1) hs-factor)) ))
    
     (setq x (rtos (nth 1 (nth n_lst pt_list))))
     (setq y (rtos (nth 2 (nth n_lst pt_list))))
     
     (princ (strcat "\rPoint Number " (nth 0 (nth n_lst pt_list))))
     (command "text" "m" ptxt1 "0" (nth 0 (nth n_lst pt_list)))
     (command "text" "m" ptxt2 "0" x)
     (command "text" "m" ptxt3 "0" y)
     (command "line" p1 p2 "")
     
     )
     (setq n_lst (+ n_lst 1))
     )
     
     (setq pv1 (list (+ (car p_l_up) (* 1.2 hs-factor))
     (cadr p_l_up) ))
     (setq pv2 (list (+ (car p_l_up) (* 4.2 hs-factor))
     (cadr p_l_up) ))
     (setq pv3 (list (+ (car p1) (* 1.2 hs-factor))
     (cadr p1) ))
     (setq pv4 (list (+ (car p1) (* 4.2 hs-factor))
     (cadr p1) ))
    
     (command "line" p_l_up p1 "")
     (command "line" pv1 pv3 "")
     (command "line" pv2 pv4 "")
     (command "line" p_r_up p2 "")
    
     (setvar "cmdecho" echo)
     (setvar "blipmode" blip)
     (setvar "luprec" decimal)
     (setq *error* olderr) ; Restore old *error* handler
     (close file)
     (princ)
    )[/list]
    [/code]

المواضيع المتشابهه

  1. أوتوكاد و إكسل Excel
    بواسطة عبدالرزاق الخريط في المنتدى أوتوكاد - ثنائي الأبعاد
    مشاركات: 5
    آخر مشاركة: 23-01-2011, 08:28
  2. الإحداثيات المطلقة في أوتوكاد > من 2004!؟
    بواسطة khaled_engineer في المنتدى أوتوكاد - ثنائي الأبعاد
    مشاركات: 2
    آخر مشاركة: 30-05-2009, 08:07
  3. تعديل الطبقات في أوتوكاد 2006 لملف محول من أوتوكاد 2002 مثلا
    بواسطة يحيى مضيه في المنتدى أوتوكاد - ثنائي الأبعاد
    مشاركات: 7
    آخر مشاركة: 21-10-2008, 10:23
  4. ارجاع الإحداثيات في أوتوكاد
    بواسطة محمدالغامدي في المنتدى المنتدى العام لنظام المعلومات الجغرافية GIS
    مشاركات: 3
    آخر مشاركة: 26-03-2008, 09:06
  5. مسابقـة 67: تعديل ليسب يرسم سهماً مفرغا ليرسمه مغلقا
    بواسطة أحمد أنور أحمد في المنتدى مسابقات أوتوكاد
    مشاركات: 23
    آخر مشاركة: 23-02-2008, 10:28

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

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

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

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

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