دورات هندسية

 

 

تعديل ليسب

النتائج 1 إلى 5 من 5
  1. [1]
    الصورة الرمزية abdolkadr
    abdolkadr
    abdolkadr غير متواجد حالياً

    عضو فعال جداً

    تاريخ التسجيل: Oct 2005
    المشاركات: 346
    Thumbs Up
    Received: 22
    Given: 26

    تعديل ليسب

    [CENTER][LEFT]
    لدي ليسب معروف لدى اغلب مهندسي المساحة والمساحين هو ليسب pt
    لاستخراج احداثيات النقاط مع ارقامها الى ملف خارجي
    وكتابة هذه الارقام على الرسم
    ولكن يستخرج النقاط على الشكل التالي
    pt E N
    انا اريد الاحداثيات PT E N Z
    اي اريدمن خبراء الليسب ان يظيف عمود بمنسوب النقطة حتى لو كان كله اصفار ZERO 0
    وهذا هو الليسب




    (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]
    abdolkadr
    abdolkadr غير متواجد حالياً
    عضو فعال جداً
    الصورة الرمزية abdolkadr


    تاريخ التسجيل: Oct 2005
    المشاركات: 346
    Thumbs Up
    Received: 22
    Given: 26

    ليس هناك ردود

    ولا رد لا حول ولا قوة الا بالله

    0 Not allowed!



  3. [3]
    الحسون المدني
    الحسون المدني غير متواجد حالياً
    عضو فعال جداً


    تاريخ التسجيل: May 2006
    المشاركات: 295
    Thumbs Up
    Received: 0
    Given: 0
    جزاك الله خيرا

    0 Not allowed!



  4. [4]
    م-تامر امين
    م-تامر امين غير متواجد حالياً
    جديد


    تاريخ التسجيل: Feb 2005
    المشاركات: 4
    Thumbs Up
    Received: 0
    Given: 0
    الاخ العزيز بدل متطلب حد يعدلك ليسب معروف زى مانت بتقول طب متسال على ليسب تانى يحول لللانت عايزه
    اللى انت عايزه ليسب اسمه pxyz
    لو عايزه انا مستنى الرد

    0 Not allowed!



  5. [5]
    MOHAMMAD TITI
    MOHAMMAD TITI غير متواجد حالياً
    عضو


    تاريخ التسجيل: Dec 2008
    المشاركات: 39
    Thumbs Up
    Received: 1
    Given: 0
    لا حولأ ولأ قوه إلإ بالله العلي القدير الله يوفقك ويهديك الى الحل يا أخ عبد القادر
    المهندس تامر أعطاك الحل ويا ريت يا أخ تامر توضعه في المنتدى وشكرأ
    محمد

    0 Not allowed!



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

عرض سحابة الكلمة الدلالية

RSS RSS 2.0 XML MAP HTML