超级OFFSET，能偏移块，XREF里面的曲线

Lisphk · 发表于 2017-7-21 12:03:47

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:OffsetNested (/ *error* AT:GetSel dist ent new)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (msg)
(and ent (redraw (car ent) 4))
(and new (entdel new))
(and cmd (setvar 'CMDECHO cmd))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(progn (vl-bt) (princ (strcat "\nError: " msg)))
)
)
(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(initget 6 "Through")
(setq dist (getdist (strcat "\nOffset Nested\nSpecify offset distance or [Through] <"
(if (minusp (getvar 'OFFSETDIST))
"Through"
(rtos (getvar 'OFFSETDIST))
)
">: "
)
)
)
(cond ((not dist))
((eq (getvar 'OFFSETDIST) dist))
((eq dist "Through") (setvar 'OFFSETDIST -1.))
((setvar 'OFFSETDIST dist))
)
(if (and (setq ent (AT:GetSel nentselp
"\nSelect object to offset: "
(lambda (x)
(member (cdr (assoc 0 (entget (car x))))
'("ARC" "CIRCLE" "ELLIPSE" "LINE" "LWPOLYLINE" "SPLINE")
)
)
)
)
(progn
(if (eq (length ent) 4)
(progn (setq new (entmakex
(subst (cons 8 (getvar 'CLAYER))
(assoc 8 (entget (car ent)))
(entget (car ent))
)
)
)
(vla-transformby (vlax-ename->vla-object new) (vlax-tmatrix (caddr ent)))
(setq ent (list new (cadr ent)))
)
)
(redraw (car ent) 3)
(setq pnt (getpoint (cadr ent)
(if (minusp (getvar 'OFFSETDIST))
"\nSpecify through point: "
"\nSpecify point on side to offset: "
)
)
)
)
)
(command "_.offset" "" ent "_non" pnt "")
)
(*error* nil)
(princ)
)
(vl-load-com)
(princ)

(defun c:OffsetNested (/ *error* AT:GetSel dist ent new) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
  (defun *error* (msg) 
    (and ent (redraw (car ent) 4)) 
    (and new (entdel new)) 
    (and cmd (setvar 'CMDECHO cmd)) 
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))) 
      (progn (vl-bt) (princ (strcat "\nError: " msg))) 
    ) 
  ) 
 
 
  (defun AT:GetSel (meth msg fnc / ent) 
    ;; meth - selection method (entsel, nentsel, nentselp) 
    ;; msg - message to display (nil for default) 
    ;; fnc - optional function to apply to selected object 
    ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC"))) 
    ;; Alan J. Thompson, 05.25.10 
    (while 
      (progn (setvar 'ERRNO 0) 
             (setq ent (meth (cond (msg) 
                                   ("\nSelect object: ") 
                             ) 
                       ) 
             ) 
             (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again.")) 
                   ((eq (type (car ent)) 'ENAME) 
                    (if (and fnc (not (fnc ent))) 
                      (princ "\nInvalid object!") 
                    ) 
                   ) 
             ) 
      ) 
    ) 
    ent 
  ) 
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
 
  (initget 6 "Through") 
  (setq dist (getdist (strcat "\nOffset Nested\nSpecify offset distance or [Through] <" 
                              (if (minusp (getvar 'OFFSETDIST)) 
                                "Through" 
                                (rtos (getvar 'OFFSETDIST)) 
                              ) 
                              ">: " 
                      ) 
             ) 
  ) 
 
  (cond ((not dist)) 
        ((eq (getvar 'OFFSETDIST) dist)) 
        ((eq dist "Through") (setvar 'OFFSETDIST -1.)) 
        ((setvar 'OFFSETDIST dist)) 
  ) 
 
  (if (and (setq ent (AT:GetSel nentselp 
                                "\nSelect object to offset: " 
                                (lambda (x) 
                                  (member (cdr (assoc 0 (entget (car x)))) 
                                          '("ARC" "CIRCLE" "ELLIPSE" "LINE" "LWPOLYLINE" "SPLINE") 
                                  ) 
                                ) 
                     ) 
           ) 
           (progn 
             (if (eq (length ent) 4) 
               (progn (setq new (entmakex 
                                  (subst (cons 8 (getvar 'CLAYER)) 
                                         (assoc 8 (entget (car ent))) 
                                         (entget (car ent)) 
                                  ) 
                                ) 
                      ) 
                      (vla-transformby (vlax-ename->vla-object new) (vlax-tmatrix (caddr ent))) 
                      (setq ent (list new (cadr ent))) 
               ) 
             ) 
 
             (redraw (car ent) 3) 
 
             (setq pnt (getpoint (cadr ent) 
                                 (if (minusp (getvar 'OFFSETDIST)) 
                                   "\nSpecify through point: " 
                                   "\nSpecify point on side to offset: " 
                                 ) 
                       ) 
             ) 
           ) 
      ) 
 
    (command "_.offset" "" ent "_non" pnt "") 
  ) 
 
  (*error* nil) 
 
  (princ) 
) 
(vl-load-com) 
(princ)

游客，如果您要查看本帖隐藏内容请回复

laiz3000 · 发表于 2017-7-21 12:37:33

好高级

q3_2006 · 发表于 2017-7-21 12:46:25

这个厉害了..

yoyoho · 发表于 2017-7-21 13:01:30

感谢分享程序！

SmartStar · 发表于 2017-7-21 14:48:32

看看隐藏了什么

434939575 · 发表于 2017-7-21 14:57:02

来学习的，路太漫长了！

sunshinejwt · 发表于 2017-7-21 15:03:14

看看隐藏了什么

HLCAD · 发表于 2017-7-21 15:12:48

太实用了，感谢楼主的源代码！

qyming1996 · 发表于 2017-7-21 15:19:59

学习，学习，学习

819534890 · 发表于 2017-7-21 16:29:40

回复学习是个好习惯

Linhay · 发表于 2017-7-21 16:52:46

马后再看

xchj81 · 发表于 2017-7-21 17:16:42

找了好久。谢谢

sicky111 · 发表于 2017-7-22 00:40:17

看标题高大上啊。

xinxirong · 发表于 2017-7-22 06:09:43

吧，也行呀？吃了饭**形象代言人

ray7891 · 发表于 2017-7-22 12:29:41

块解决？

账号		自动登录	找回密码
密码			立即注册

[每日一码] 超级OFFSET，能偏移块，XREF里面的曲线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评