拿透镜有困难
您好，我有一个lisp程序，它使用DCL文件将自定义数据附加到实体。一切正常，但我试图让“长度”字段返回实体的实际长度，而不是手动输入。我并没有试图用这些数据来处理行长度，我只是想要实际值。任何帮助都会很好，我只是不确定我应该研究什么功能。这是代码，它是来自AfraLISP的经过大量修改的代码，它工作得很好，但我也在尝试添加此功能
(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 numberlist
(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 anglelist
(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 floorlist
(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)
(repeatnum
(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
谢谢你的建议，
布瑞恩
附笔
如果我的意图不明确，我可以上传一段视频
这是我的DCL，这是我运行lisp程序时得到的
我想做的是让长度字段由实际长度填充
页:
[1]