[编程交流] 拿透镜有困难

(defun c:ENDT ( / )
;define function
(setvar "cmdecho" 0)
;switch off command echo
 
(prompt "\nSelect the entity to Modify data : ")
;prompt the user        
         
(setq e (entget (car (entsel)) '("AFRALISP")))
;get the associative code list
(setq e1 (assoc -3 e))
;get the xdata
(if (not e1)
;if there is no exdata
(progn
;do the following
(if (not (tblsearch "APPID" "AFRALISP"))
;check if the application has been registered
        
        (regapp "AFRALISP")
        ;if not, register it
);if
        (setq e1 '(( -3 ("AFRALISP"
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
                  (1000 . " ")
        ))))
        ;create a default xdata list
        
        (setq e (append e e1))
        ;append to to the main list
        (entmod e)
        ;modify the entity
        
);progn
);if
(setq e2 (assoc -3 e))
;get the code -3 list
(setq e3 (car (cdr e2)))
;get the exdata list
(setq PN (cdr (nth 1 e3)))
;get the partnumber index number
(setq EV (cdr (nth 2 e3)))
;get the elevation index number
(setq DS (cdr (nth 3 e3)))
;get the description index number
         (setq LE (cdr (nth 4 e3)))
;get the Leading Angle index number
(setq TR (cdr (nth 5 e3)))
;get the trainling Angle index number
(setq FL (cdr (nth 6 e3)))
;get the floor index number
         (setq TA (cdr (nth 7 e3)))
;get the tag index number
(setq CO (cdr (nth 8 e3)))
;get the color index number
(setq LN (cdr (nth 9 e3)))
;get the length index number
         (setq QU (cdr (nth 10 e3)))
;get the quanity index number
(setq userclick T)
;set flag
(setq PN1 PartNumber)
;Part Number Entry        
(setq EL1 Elevation)
;Elevation Value Entry
         (setq DS1 Description)
;Description value entry
         (setq LE1 Langle)
;Part leading angle entry        
(setq TR1 Tangle)
;part trailing angle entry
         (setq FL1 Floor)
;floor
         (setq TA1 Tag)
;Tag        
(setq CO1 Color)
;Color Value Entry
         (setq LN1 PartLength)
;Length
         (setq QU1 Quantity)
;Quantity        
(setq dcl_id (load_dialog "newENDT.dcl"))
;load dialogue
(if (not (new_dialog "ENDT" dcl_id)
;check for errors
      );not
     (exit)
     ;if problem exit
);if
 
 (set_tile "PN1" PN)
 ;initilise list box
 (set_tile "EV1" EV)
 ;initilise list box
 (set_tile "DS1" DS)
 ;initilise list box
 (set_tile "LE1" LE)
 ;initilise list box
 (set_tile "TR1" TR)
 ;initilise list box
 (set_tile "FL1" FL)
 ;initilise list box
 (set_tile "TA1" TA)
 ;initilise list box
 (set_tile "CO1" CO)
 ;initilise list box
 (set_tile "LN1" LN)
 ;initilise list box
 (set_tile "QU1" QU)
 ;initilise list box
 (start_list "PN1")
 ;start the list
 (mapcar 'add_list PartNumber)
 ;add the partnumber
 (start_list "EV1")
 ;start the list
 (mapcar 'add_list Elevation)
 ;add the elevation
 (start_list "DS1")
 ;start the list
 (mapcar 'add_list Description)
 ;add the description
 (start_list "LE1")
 ;start the list
 (mapcar 'add_list Langle)
 ;add the leading angle
 (start_list "TR1")
 ;start the trainling angle
 (mapcar 'add_list Tangle)
 ;add the trailing angle
 (start_list "FL1")
 ;start the floor
 ;(mapcar 'add_list Floor)
 ;add the floor
 (start_list "TA1")
 ;start the tag
 (mapcar 'add_list Tag)
 ;add the tag
 (start_list "CO1")
 ;start the color
 ;(mapcar 'add_list Color)
 ;add the colr
 (start_list "LN1")
 ;start the length
 ;(mapcar 'add_list PartLength)
 ;add the length
 
 (start_list "QU1")
 ;start the quantity
 ;(mapcar 'add_list Quantity)
 ;add the quantity
 
 (end_list)
 ;end the list
   (action_tile "cancel"        
   ;if cancel selected
        "(done_dialog)
;end dialog
 (setq userclick nil)"
 ;set flag to nill
   );action_tile
   ;if cancel set flag to nil
(action_tile "accept"        
 "(setq PN (get_tile "PN1"))
 
 (setq EV (get_tile "EV1"))
 
 (setq DS (get_tile "DS1"))
 
 (setq LE (get_tile "LE1"))
 (setq TR (get_tile "TR1"))
 (setq FL (get_tile "FL1"))
 
 (setq TA (get_tile "TA1"))
 
 (setq co (get_tile "CO1"))
 (setq LN (get_tile "LN1"))
 (setq QU (get_tile "QU1"))
         
 (done_dialog)
 
 (setq userclick T)"
 ;set the flag to true
);action tile
 (start_dialog)        
 ;start the dialogue
 (unload_dialog dcl_id)        
 ;unload the dialogue
  (if userclick        
  ;if OK has been selected
   (progn
   ;do the following
(setq NPN (cons 1000 PN))
;construct a new part number  list
(setq NEV (cons 1000 EV))
       ;construct a new elevation list
(setq NDS (cons 1000 DS))
;construct a new description list 
       (setq NLE (cons 1000 LE))
;construct a new leading angle  list
(setq NTR (cons 1000 TR))
       ;construct a new trailing angle list
(setq NFL (cons 1000 FL))
;construct a new floor list
              (setq NTA (cons 1000 TA))
;construct a new floor  list
(setq NCO (cons 1000 CO))
       ;construct a new color list
(setq NLN (cons 1000 LN))
;construct a new length list
       (setq NQU (cons 1000 QU))
;construct a new quantity list
     
(setq e4 (chnitem NPN 2 e3))
;change the Partnumber list
(setq e5 (chnitem NEV 3 e4))
;change the elevation list
(setq e6 (chnitem NDS 4 e5))
;change the Description list
       (setq e7 (chnitem NLE 5 e6))
;change the leading list
(setq e8 (chnitem NTR 6 e7))
;change the trailing list
(setq e9 (chnitem NFL 7 e8))
;change the floor list
       (setq e10 (chnitem NTA 8 e9))
;change the tag list
(setq e11 (chnitem NCO 9 e10))
;change the color list
(setq e12 (chnitem NLN 10 e11))
;change the length list
(setq e13 (chnitem NQU 11 e12))
;change the quantity list
     
;break
     
(setq e14 (subst e13 e3 e2))
;update list
(setq e15 (subst e14 e2 e))
;update list
(entmod e15)
;update the entity
     
   (setq PN (nth (atoi PN) PartNumber))
   ;get the Part Number from the list
   (setq EV (nth (atoi EV) Elevation))
    ;get the elevation from list
     
   (setq DS (nth (atoi DS) Description)) 
    ;get the Description from the list
   (setq LE (nth (atoi LE) Langle))
    ;get the leading from the list
   (setq TR (nth (atoi TR) Tangle))
    ;get the trailing from list
     
   (setq FL (nth (atoi FL) Floor)) 
    ;get the floor from the list
   (setq TA (nth (atoi TA) Tag))
    ;get the tag from the list
   (setq CO (nth (atoi CO) Color))
    ;get the color from list
     
   (setq LN (nth (atoi LN) PartLength)) 
    ;get the Length from the list
   (setq QU (nth (atoi QU) Quantity)) 
    ;get the Quantity from the list
     
   (alert (strcat "The Part Number is " PN "\n"
    "The Elevation is " EV "\n"
    "The Description is " DS "\n"
    "The Leading Angle is " LE "\n"
    "The Trailing Angle is " TR "\n"
           "The Floor is " FL "\n"
    "The Tag is " TA "\n"
           "The Color is " CO "\n"
    "The Length is " LN "\n"
             "The Quanity is " QU)
    
    );alert
   );end progn
  );end if
(princ)
;finish cleanly
);end defun
;;This function replaces any element in a list with another element
;;It requires 3 parameters (chnitem value itemnumber list)
(defun chnitem (value num lst)
    (setq num (- num 1))
    (setq tmplt (list nil))
    (setq tmplt2 (list nil))
    (setq counter 0)
    (repeat  num
         (setq tmplt (append tmplt (list (nth counter lst))))
         (setq counter (+ counter 1))
    )
    (setq counter (+ counter 1))
    (repeat (- (length lst) (+ num 1))
         (setq tmplt2 (append tmplt2 (list (nth counter lst))))
         (setq counter (+ counter 1))
    )
    (setq tmplt (cdr tmplt))
    (setq tmplt2 (cdr tmplt2))
    (setq lst (append tmplt (list value) tmplt2))
)
(
princ)
;load cleanly