帮我解决口齿不清的问题
大家好，我编写了一个lisp例程，当我运行它时，它会通过单击对象的边界将我需要的内容锁定到一个单独的文件中，它使用（Useri1）变量来指定文件名，这很好，但我希望能够单击零件号（B2），例如，当人们使用它时，文件名就是零件号。如果有任何帮助，我将不胜感激。
(defun c:psave (/ ss mn mx)
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(princ "\n Panel Number is ")(princ (getvar "useri1"))
(princ ". To change this, reset the system variable USERI1")
(setq pnum(getvar "useri1"))
(if(= pnum 0)(setq pnum 1))
(setvar "useri1" (+ pnum 1))
(setq pnum(itoa pnum))
(if (setq ss(ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
(progn
(vla-getboundingbox (vlax-ename->vla-object (ssname ss 0)) 'mn'mx)
(command "wblock" pnum " " "0" "WINDOW"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
"")
(setvar "cmdecho" 1)
(setvar "filedia" 1)
)
)
)
(princ)
谢谢
布瑞恩 你能附上一个样本图纸吗？ 这是一个标准面板的图纸。我想做的就是为“pnum”选择（B2），然后选择蓝线。
B2.dwg 这是一种拉出B2的方法
(setq text1 (entget (car (entsel "\nSelect text 1 "))))
(setq anst1 (cdr (assoc 1 text1)))
then do something like
(setq outdwg (strcat anst1 "-" (getvar "dwgname")) 也许是这样的：
(defun c:psave (/ ss mn mx sst)
(vl-load-com)
(if (setq ss (ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
(progn
(vla-getboundingbox (vlax-ename->vla-object (ssname ss 0)) 'mn 'mx)
(setq sst (ssget "W"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
'((0 . "text") (1 . "@*"))
)
)
(command "-wblock"
(strcat (getvar "dwgprefix")
(cdr (assoc 1 (entget (ssname sst 0))))
)
" "
"0"
"WINDOW"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
""
)
(command "oops")
)
;; progn
)
;; if
(princ)
)
BIGAL，我确实得到了我写的第一个lisp，用下面的代码做我想做的事情
(defun c:psave2 (/ ss mn mx)
(vl-load-com)
;;;--- Turn the command echo off
(setvar "cmdecho" 0)
;;;--- Turn the filedia off
(setvar "filedia" 0)
(setq datalist (list))
;select objects
(if (setq eset (ssget))
(progn
;set a counter to the first item in the selection set
(setq cntr 0)
;loop through each selected entity
(while (< cntr (sslength eset))
;grab the entity's name
(setq en (ssname eset cntr))
;grab the DXF group codes of the entity
(setq enlist (entget en))
;ignore the entity if it is not a TEXT entity
(if (= "TEXT" (cdr (assoc 0 enlist)))
(progn
;get the text value from the DXF Group Code
(setq str (cdr (assoc 1 enlist)))
;setup a variable to check if the entity exist in the datalist list
(setq existing 0)
;loop through the datalist to find out if it is a new entity that needs
;to be added to the list or if it already exist and it's counter needs
;to be incremented
(foreach a datalist
(if (= (car a) str)
(setq existing 1)
)
)
;if the entity is new then
(if (= existing 0)
;do this - Add the item to the datalist along with a counter that starts at 1
(setq datalist (append datalist (list (cons str 1))))
;else it's cntr needs to be incremented
(setq datalist
(subst
(cons str (+ 1 (cdr (assoc str datalist))))
(assoc str datalist)
datalist
)
)
)
)
)
;increment the entity counter
(setq cntr (+ cntr 1))
)
)
)
(if (setq ss(ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
(progn
(vla-getboundingbox (vlax-ename->vla-object (ssname ss 0)) 'mn'mx)
(command "wblock" str " " "0" "WINDOW"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
"")
;;;--- Turn the command echo back on
(setvar "cmdecho" 1)
;;;--- Turn the filedia back on
(setvar "filedia" 1)
)
)
)
(princ)
但是对于你发布的代码行，它工作得更好，对于我的lisp，你必须在选择标签和蓝线之间点击enter。这是我的lisp和你的代码行放在一起。
(defun c:psave (/ ss mn mx)
(vl-load-com)
(setvar "cmdecho" 0)
(setq text1 (entget (car (entsel "\nSelect Label "))))
(setq anst1 (cdr (assoc 1 text1)))
(setq outdwg (strcat anst1 "-" (getvar "dwgname"))
)
(if (setq ss(ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
(progn
(vla-getboundingbox (vlax-ename->vla-object (ssname ss 0)) 'mn'mx)
(command "wblock" anst1 " " "0" "WINDOW"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
"")
(setvar "cmdecho" 1)
)
)
)
(princ)
现在你会注意到我把“文本1”改成了“标签”，这样就不会把任何人搞糊涂了。我想知道我需要向lisp例程添加哪些代码行才能将创建的文件保存到原始图形所在的当前文件夹中。谢谢你的帮助，你的男人。 嗯，席尔瓦，这正是我想要的。谢谢。。。 不客气，布莱恩特。
亨里克 BrianTFC，
如果当前目录中已存在同名文件，则代码会出错，
因为wblock命令停止询问是否要替换现有的dwg，所以我只是
添加“if”以查看当前目录中是否已存在具有所需名称的文件
要创建wblock，如果为true，将显示一个警报框，说明文件已经存在
存在并退出代码。
希望有帮助
亨里克
(defun c:psave (/ ss mn mx sst)
(vl-load-com)
(if (setq ss (ssget "_:S:E" '((0 . "INSERT,LWPOLYLINE"))))
(progn
(vla-getboundingbox
(vlax-ename->vla-object (ssname ss 0))
'mn
'mx
)
(setq sst (ssget "W"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
'((0 . "text") (1 . "@*"))
)
)
(if (= (findfile (strcat (getvar "dwgprefix")
(cdr (assoc 1 (entget (ssname sst 0))))
".dwg"
)
)
nil
)
(progn
(command "-wblock"
(strcat (getvar "dwgprefix")
(cdr (assoc 1 (entget (ssname sst 0))))
)
" "
"0"
"WINDOW"
(trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1)
""
)
(command "oops")
)
;; progn
(alert
(strcat "\nThe "
(cdr (assoc 1 (entget (ssname sst 0))))
".dwg already exists in the current directory!!!"
)
)
)
;; if
)
;; progn
)
;; if
(princ)
)
您可以将专家设置为5以抑制消息
“…dwg已存在，是否替换它？[是/否]：
很高兴在这里见到你，亨里克，欢迎来到CADTutor。
页:
[1]
2