tmelancon 发表于 2022-7-5 22:37:24

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,所以这是我需要的。也可以有人添加一个多件?
 
 
上帝保佑!

hanhphuc 发表于 2022-7-5 22:45:04

嗨,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)
)   


tmelancon 发表于 2022-7-5 22:50:16

嘿,对不起,我今天早上很忙,说得不太好。我正在寻找的偏移倍数将包括在那里的某个地方,给用户的选择只是抵消一行,然后结束例行程序,或键入多行选择。希望这有帮助!

iconeo 发表于 2022-7-5 22:59:47

如果你从一个按钮开始这个lisp,你可以简单地在命令前加一个星号。。。
 
*^C^C(如果(非C:OFF2)(加载“OFF2”))OFF2;
 
这假设lisp位于您的一个支持目录中,并命名为OFF2。
 
干杯

tmelancon 发表于 2022-7-5 23:06:20

Hmm提示用户点击回车键/空格键,以启动实际距离的0.0812。我试着在dist后面加上“”,它说明了太多的论点。我只是想添加它,这样它会自动点击回车键,并提示行选择。。为什么和我争论

iconeo 发表于 2022-7-5 23:09:14

我认为:
 
(setq offDist(ureal 6”“”\n指定偏移距离:“0.812”)
 
可以简单地更改为。。。
 
(setq offDist 0.812)
 
http://www.afralisp.net/autolisp/tutorials/set-and-setq.php

tmelancon 发表于 2022-7-5 23:18:49

给大家道具!成功!谢谢大家。你们太棒了值得注意:

tmelancon 发表于 2022-7-5 23:23:12

如果我们可以对图层执行相同的操作,是否可能像指定线型一样。。比如把它放在一个指定的选择层上?两条偏移线?

hanhphuc 发表于 2022-7-5 23:28:09

 
是的,我们可以修改代码,但你要确保对原始代码的作者礼貌,赞扬他的想法或通知他。
 
这个例子:我使用(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->然后输入偏移距离->选择多个对象

BIGAL 发表于 2022-7-5 23:34:29

2个建议你可以在一段时间内结束例程,即在你不拾取任何对象的时候继续拾取对象,在屏幕上留出空间,退出1个拾取就可以了,或者可以选择比“M”更简单的任意数量。第二,可能更容易再次预设偏移量,并使用Enter键提示接受或键入新值。对于多个,它只会在开始时询问一次,如果需要多个不同的值,则是退出,请再次保存一些接受步骤。层相同。上述海报可能会考虑将这些想法纳入其代码中。
页: [1] 2
查看完整版本: Offset LISP例程只需要