Offset LISP例程只需要
刚刚遇到了这个简洁的Lisp程序的程序。这对我和我的伙计们来说都非常合适,因为我们对管道进行了隔热处理,这样就不需要点击来不断地双向偏移管线。(defun C:OFF2(/ pickEnt pickObj offDist)
(vl-load-com)
(setvar "ErrNo" 0)
(while (and (not (setq pickEnt (entsel))) (/= 52 (getvar "ErrNo"))))
(cond ((and pickEnt
(setq pickObj (vlax-EName->vla-Object (car pickEnt)))
(progn (initget 6)
(setq offDist (getdist "\nSpecify offset distance: "))))
(vla-Offset pickObj offDist)
(vla-Offset pickObj (- offDist))
(I:PutCL pickObj)))
(princ))
(defun I:PutCL(myObj / linetypes ltName)
(setq linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
ltName "Center")
(cond ((vl-catch-all-error-p
(vl-catch-all-apply 'vla-Item (list linetypes ltName)))
(vla-Load linetypes
ltName
(cond ((= (getvar "Measurement") 0) "Acad.lin")
("AcadISO.lin")))))
(vla-Put-Linetype myObj ltName))
问题:有人可以看一下,而不是提示偏移距离(因为我们已经有一个标准的设置距离总是)为0.812,所以这是我需要的。也可以有人添加一个多件?
上帝保佑! 嗨,tmelancon,这是一次点击的快速修改,
你能解释一下M的其他选择吗?还是对同一实体重复?
(defun C:OFF2 (/ pickEnt pickObj offDist)
(vl-load-com)
(setq offDist(ureal 6 "" "\nSpecify offset distance: " 0.812))
(while (setq pickEnt (entsel))
(cond ((and pickEnt (setq pickObj (vlax-EName->vla-Object (car pickEnt))) offDist)
(vla-Offset pickObj offDist)
(vla-Offset pickObj (- offDist))
(I:PutCL pickObj)
)
) ;_ end of cond
) ;_ end of while
(princ)
) ;_ end of defun
(defun I:PutCL (myObj / linetypes ltName)
(setq linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
ltName "Center"
) ;_ end of setq
(cond ((vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list linetypes ltName)))
(vla-Load linetypes
ltName
(cond ((= (getvar "Measurement") 0) "Acad.lin")
("AcadISO.lin")
) ;_ end of cond
) ;_ end of vla-Load
)
) ;_ end of cond
(vla-Put-Linetype myObj ltName)
) ;_ end of defun
;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
(defun UREAL (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (rtos def 2) "> : ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg " : "))
) ;if
(initget bit kwd)
(setq inp (getdist msg))
(if inp inp def)
)
嘿,对不起,我今天早上很忙,说得不太好。我正在寻找的偏移倍数将包括在那里的某个地方,给用户的选择只是抵消一行,然后结束例行程序,或键入多行选择。希望这有帮助! 如果你从一个按钮开始这个lisp,你可以简单地在命令前加一个星号。。。
*^C^C(如果(非C:OFF2)(加载“OFF2”))OFF2;
这假设lisp位于您的一个支持目录中,并命名为OFF2。
干杯 Hmm提示用户点击回车键/空格键,以启动实际距离的0.0812。我试着在dist后面加上“”,它说明了太多的论点。我只是想添加它,这样它会自动点击回车键,并提示行选择。。为什么和我争论 我认为:
(setq offDist(ureal 6”“”\n指定偏移距离:“0.812”)
可以简单地更改为。。。
(setq offDist 0.812)
http://www.afralisp.net/autolisp/tutorials/set-and-setq.php 给大家道具!成功!谢谢大家。你们太棒了值得注意: 如果我们可以对图层执行相同的操作,是否可能像指定线型一样。。比如把它放在一个指定的选择层上?两条偏移线?
是的,我们可以修改代码,但你要确保对原始代码的作者礼貌,赞扬他的想法或通知他。
这个例子:我使用(getvar“clayer”)当前层
;;;http://www.cadtutor.net/forum/showthread.php?88082-Offset-LISP-Routine-just-needs-small-update.-Thanks!
(if (not *offDist*)
(setq *offDist* 0.812)
) ;_ end of if
(defun C:OFF2 (/ pickEnt pickObj offDist ss)
(vl-load-com)
(setvar "ErrNo" 0)
(setq offDist (ureal 6 "Multiple" "\nSpecify offset distance or : " *offDist*)) ; _ end of
; setq
(if (= offDist "Multiple")
(progn (setq offDist (ureal 6 "" "\nSpecify offset distance: " *offDist*)
*offDist* offDist
) ;_ end of setq
(prompt "\nSelect object.. ")
(setq ss (ssget))
(foreach en (vl-remove-if ''((x) (listp x)) (mapcar 'cadr (ssnamex ss))) ;_ end of vl-remove-if
(offset2: en offDist (getvar "clayer"))
) ;_ end of foreach
) ;_ end of progn
(while (setq pickEnt (entsel))
(offset2: (car pickEnt) offDist (getvar "clayer"))
(setq *offDist* offDist)
) ; _ end of
; while
) ;_ end of if
(princ)
) ;_ end of defun
; modified by hanhphuc* 09/08/2014
(defun offset2: (e off lay / obj)
(if (and e
off
(= (type lay) 'STR)
(tblsearch "Layer" lay)
(member (vla-get-objectname (setq obj (vlax-EName->vla-Object e)))
'("AcDbCircle" "AcDbArc" "AcDbPolyline" "AcDbLine" "AcDbEllipse" "AcDbSpline")
) ;_ end of member
) ;_ end of and
(progn (foreach o (list (vla-Offset obj off) (vla-Offset obj (- off)))
(vla-put-layer (car (vlax-safearray->list (vlax-variant-value o))) lay)
) ;_ end of foreach
(I:PutCL obj)
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
(defun I:PutCL (myObj / linetypes ltName)
(setq linetypes (vla-Get-Linetypes (vla-Get-Document myObj))
ltName "Center"
) ;_ end of setq
(cond ((vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list linetypes ltName)))
(vla-Load linetypes
ltName
(cond ((= (getvar "Measurement") 0) "Acad.lin")
("AcadISO.lin")
) ;_ end of cond
) ;_ end of vla-Load
)
) ;_ end of cond
(vla-Put-Linetype myObj ltName)
) ;_ end of defun
;;;-------------------------------------------------------------------
;; This function is freeware courtesy of the author's of "Inside AutoLisp"
;; for rel. 10 published by New Riders Publications.This credit must
;; accompany all copies of this function.
;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;* for INITGET. MSG is the prompt string, to which a default string is added
;;* as <DEF> (nil or "" for none), and a : is added.
(defun UREAL (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (rtos def 2) "> : ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg " : "))
) ;if
(initget bit kwd)
(setq inp (getdist msg))
(if inp inp def)
)
对于[多个],输入M->然后输入偏移距离->选择多个对象 2个建议你可以在一段时间内结束例程,即在你不拾取任何对象的时候继续拾取对象,在屏幕上留出空间,退出1个拾取就可以了,或者可以选择比“M”更简单的任意数量。第二,可能更容易再次预设偏移量,并使用Enter键提示接受或键入新值。对于多个,它只会在开始时询问一次,如果需要多个不同的值,则是退出,请再次保存一些接受步骤。层相同。上述海报可能会考虑将这些想法纳入其代码中。
页:
[1]
2