自动偏移-适用于画大样钢筋

cmssrr520 · 发表于 2013-10-25 11:17:06

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

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

×

本帖最后由 newer 于 2013-10-25 13:08 编辑

;;; (defun c:so ()
;;; (vl-load-com)
;;; (setq lineobj (vlax-ename->vla-object (car (entsel))))
;;; (vla-offset lineobj 70)
;;; (vla-offset lineobj -70)
;;; (princ)
;;; )
;;; pline、line、spline、arc、circle，统统反向：
(defun fx (/ ent ent1 q q2 cp r os lst)
(prompt "将各种线型反向……")
(print)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ent (entget (setq ent1 en)))
(cond
((= (cdr (assoc 0 ent)) "LWPOLYLINE")
(reverselwp ent1)
)
((= (cdr (assoc 0 ent)) "LINE")
(setq q (cons 10 (cdr (assoc 11 ent)))
q2 (cons 11 (cdr (assoc 10 ent)))
) ; _ 结束setq
(setq ent (subst
q
(assoc 10 ent)
ent
)
ent (subst
q2
(assoc 11 ent)
ent
)
) ; _ 结束setq
(entmod ent)
)
((= (cdr (assoc 0 ent)) "SPLINE")
(command "SPLINEDIT" ent1 "E" "")
)
((= (cdr (assoc 0 ent)) "ARC")
(command "pedit" ent1 "y" "")
(setq ent1 (entlast))
(reverselwp ent1)
)
((= (cdr (assoc 0 ent)) "CIRCLE")
(setq cp (cdr (assoc 10 ent))
r (cdr (assoc 40 ent))
) ; _ 结束setq
(entmake (setq lst (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '
(67 . 0) '(410 . "Model") '(100 . "AcDbPolyline")
'(90 . 2) '(70 . 129) (cons 10
(polar cp 0 r)
) '(40 . 0) '
(41 . 0) '(42 . -1) (cons 10 (polar cp pi r))
'(40 . 0) '(41 . 0) '(42 . -1)
) ; list
) ; setq
) ; entmake
(command "_matchprop" ent1 (entlast) "")
(entdel ent1)
)
(t
(prompt "\n这个东西不能反转。")
)
) ; _ 结束cond
(setvar "osmode" os)
(princ)
)
;;; _ 结束defun
;;; 子程序：pline顶点逆序
(defun reverselwp (ent1 / a pl how li1 li2 li3)
(setq pl (entget ent1 '("*"))
how nil
) ; _ 结束setq
(foreach an pl
(if (setq a (member (car an) '(10 40 41 42)))
(setq how t)
) ; _ 结束if
(cond
((not how)
(setq li1 (cons an li1))
)
((and
how
a
)
(cond
((= (car an) 40)
(setq an (cons 41 (cdr an)))
)
((= (car an) 41)
(setq an (cons 40 (cdr an)))
)
((= (car an) 42)
(setq an (cons 42 (- 0 (cdr an))))
)
(t
an
)
) ; _ 结束cond
(setq li2 (cons an li2))
)
((and
how
(not a)
)
(setq li3 (cons an li3))
)
) ; _ 结束cond
) ; _ 结束foreach
(entmod (append
(reverse li1)
(append
(cdddr li2)
(list (car li2) (cadr li2) (caddr li2))
)
(reverse li3)
) ; _ 结束append
) ; _ 结束entmod
)
;;; _ 结束defun
;;; 按计算三角形oij的倍面积
(defun calo2a (pti ptj)
(- (* (car pti) (cadr ptj)) (* (car ptj) (cadr pti)))
)
;;; 判断多段线是否为逆时针走向，ename图元必须为lwpolyline
(defun clockwisep (ename / ptlist)
(setq ptlist (apply
'append
(mapcar
'(lambda (x)
(if (= 10 (car x))
(list (cdr x))
)
)
(entget ename)
)
)
)
(> (apply
'+
(mapcar
'calo2a
(cons (last ptlist) (reverse (cdr (reverse ptlist))))
ptlist
)
) 0
)
)
(vl-load-com)
(defun c:zdpywgj (/ old_os ss m n en obj endt ename pt10 pt11 ang endt01 endt02
xx judgement enx date lay pt1 pt2 myss ss1 ss2 dst
)
(princ "\n批量自动偏移为钢筋=ZDPYWGJ=【海盗曹跬步+27/2013.01.29】")
(princ "\n***>>>>>Welcome to 批量自动偏移为钢筋<<<<<***")
(setq old_os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq enx (car (entsel "\n选择操作的图层<退出>:")))
(setq date (entget enx))
(setq lay (cdr (assoc 8 date)))
(princ (strcat "\n选中了图层【" lay "】"))
(setq pt1 (getpoint "\n请输入第一个角点:"))
(setq pt2 (getpoint "\n请输入第二个角点:"))
(if (null (setq dst (getdist (strcat "\n输入偏移距离(向内为负,向外为正)<目前为"
(rtos (getvar "OFFSETDIST") 2 0) ">:"
)
)
)
)
(setq dst (getvar "OFFSETDIST"))
(setvar "OFFSETDIST" dst)
)
(setq ss (ssget "_c" pt1 pt2 (list (cons 8 lay) (cons 0 "*line")))
m (sslength ss)
n 0
)
(command "_undo" "_be")
(command "_.ucs" "")
(while (< n m)
(setq en (ssname ss n))
(setq judgement (clockwisep en))
(if (= judgement t)
(progn
(fx)
(setq endt (entget en))
(setq ename (cdr (assoc 0 endt)))
(if (member ename (list "XLINE" "RAY"))
(progn
(setq pt10 (cdr (assoc 10 endt))
pt11 (cdr (assoc 11 endt))
ang (atan (/ (cadr pt11) (car pt11)))
)
(setq endt01 (subst
(cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10))
(assoc 10 endt)
endt
)
)
(entmake endt01)
(setq endt02 (subst
(cons 10 (polar pt10 (- ang (* 0.5 pi)) 10))
(assoc 10 endt)
endt
)
)
(entmake endt02)
)
(progn
(setq obj (vlax-ename->vla-object en))
(vl-catch-all-apply '(lambda (xx)
(vla-offset xx (- 0 dst)) ; (vla-offset
; xx -70)
) (list obj)
)
)
)
)
(progn
(setq endt (entget en))
(setq ename (cdr (assoc 0 endt)))
(if (member ename (list "XLINE" "RAY"))
(progn
(setq pt10 (cdr (assoc 10 endt))
pt11 (cdr (assoc 11 endt))
ang (atan (/ (cadr pt11) (car pt11)))
)
(setq endt01 (subst
(cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10))
(assoc 10 endt)
endt
)
)
(entmake endt01)
(setq endt02 (subst
(cons 10 (polar pt10 (- ang (* 0.5 pi)) 10))
(assoc 10 endt)
endt
)
)
(entmake endt02)
)
(progn
(setq obj (vlax-ename->vla-object en))
(vl-catch-all-apply '(lambda (xx)
(vla-offset xx (- 0 dst)) ;
; (vla-offset xx -70)
) (list obj)
)
)
)
)
)
(command "_.change" (entlast) "" "p" "la" "rein" "")
(setq n (1+ n))
)
(setq ss1 (ssget "_c" pt1 pt2 '((8 . "rein"))))
(repeat (sslength ss1)
(command "._explode" ss1)
)
(setq ss2 (ssget "_c" pt1 pt2 '((8 . "rein"))))
(command "_.pedit" "m" "p" "" "y" "w" "30" "")
(setvar "osmode" old_os)
(command "_.ucs" "_p")
(command "_.undo" "_e")
(setvar "cmdecho" 1)
(princ "\n***>>>>>End of 批量自动偏移为钢筋<<<<<***")
(princ)
)

;;; (defun c:so () 
;;;  (vl-load-com) 
;;;  (setq lineobj (vlax-ename->vla-object (car (entsel)))) 
;;;  (vla-offset lineobj 70) 
;;;  (vla-offset lineobj -70) 
;;;  (princ) 
;;; ) 
 
 
 
 
;;; pline、line、spline、arc、circle，统统反向： 
(defun fx (/ ent ent1 q q2 cp r os lst) 
  (prompt "将各种线型反向……") 
  (print) 
  (setq os (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setq ent (entget (setq ent1 en))) 
  (cond 
    ((= (cdr (assoc 0 ent)) "LWPOLYLINE") 
      (reverselwp ent1) 
    ) 
    ((= (cdr (assoc 0 ent)) "LINE") 
      (setq q (cons 10 (cdr (assoc 11 ent))) 
            q2 (cons 11 (cdr (assoc 10 ent))) 
      )                                       ; _ 结束setq 
      (setq ent (subst 
                  q 
                  (assoc 10 ent) 
                  ent 
                ) 
            ent (subst 
                  q2 
                  (assoc 11 ent) 
                  ent 
                ) 
      )                                       ; _ 结束setq 
      (entmod ent) 
    ) 
    ((= (cdr (assoc 0 ent)) "SPLINE") 
      (command "SPLINEDIT" ent1 "E" "") 
    ) 
    ((= (cdr (assoc 0 ent)) "ARC") 
      (command "pedit" ent1 "y" "") 
      (setq ent1 (entlast)) 
      (reverselwp ent1) 
    ) 
    ((= (cdr (assoc 0 ent)) "CIRCLE") 
      (setq cp (cdr (assoc 10 ent)) 
            r (cdr (assoc 40 ent)) 
      )                                       ; _ 结束setq 
      (entmake (setq lst (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") ' 
                               (67 . 0) '(410 . "Model") '(100 . "AcDbPolyline") 
                               '(90 . 2) '(70 . 129) (cons 10 
                                                           (polar cp 0 r) 
                                                     ) '(40 . 0) ' 
                               (41 . 0) '(42 . -1) (cons 10 (polar cp pi r)) 
                               '(40 . 0) '(41 . 0) '(42 . -1) 
                         )               ; list 
 
 
 
 
 
 
 
 
 
               )                       ; setq 
      )                                       ; entmake 
      (command "_matchprop" ent1 (entlast) "") 
      (entdel ent1) 
    ) 
    (t 
      (prompt "\n这个东西不能反转。") 
    ) 
  )                                       ; _ 结束cond 
  (setvar "osmode" os) 
  (princ) 
) 
;;; _ 结束defun 
 
;;; 子程序：pline顶点逆序 
(defun reverselwp (ent1 / a pl how li1 li2 li3) 
  (setq pl (entget ent1 '("*")) 
        how nil 
  )                                       ; _ 结束setq 
  (foreach an pl 
    (if (setq a (member (car an) '(10 40 41 42))) 
      (setq how t) 
    )                                       ; _ 结束if 
    (cond 
      ((not how) 
        (setq li1 (cons an li1)) 
      ) 
      ((and 
         how 
         a 
       ) 
        (cond 
          ((= (car an) 40) 
            (setq an (cons 41 (cdr an))) 
          ) 
          ((= (car an) 41) 
            (setq an (cons 40 (cdr an))) 
          ) 
          ((= (car an) 42) 
            (setq an (cons 42 (- 0 (cdr an)))) 
          ) 
          (t 
            an 
          ) 
        )                               ; _ 结束cond 
        (setq li2 (cons an li2)) 
      ) 
      ((and 
         how 
         (not a) 
       ) 
        (setq li3 (cons an li3)) 
      ) 
    )                                       ; _ 结束cond 
 
 
 
 
 
 
 
 
 
  )                                       ; _ 结束foreach 
  (entmod (append 
            (reverse li1) 
            (append 
              (cdddr li2) 
              (list (car li2) (cadr li2) (caddr li2)) 
            ) 
            (reverse li3) 
          )                               ; _ 结束append 
  )                                       ; _ 结束entmod 
 
 
 
 
 
 
 
 
 
) 
;;; _ 结束defun 
 
 
 
 
 
;;; 按计算三角形oij的倍面积 
(defun calo2a (pti ptj) 
  (- (* (car pti) (cadr ptj)) (* (car ptj) (cadr pti))) 
) 
;;; 判断多段线是否为逆时针走向，ename图元必须为lwpolyline 
(defun clockwisep (ename / ptlist) 
  (setq ptlist (apply 
                 'append 
                 (mapcar 
                   '(lambda (x) 
                      (if (= 10 (car x)) 
                        (list (cdr x)) 
                      ) 
                    ) 
                   (entget ename) 
                 ) 
               ) 
  ) 
  (> (apply 
       '+ 
       (mapcar 
         'calo2a 
         (cons (last ptlist) (reverse (cdr (reverse ptlist)))) 
         ptlist 
       ) 
     ) 0 
  ) 
) 
 
 
 
 
 
 
(vl-load-com) 
(defun c:zdpywgj (/ old_os ss m n en obj endt ename pt10 pt11 ang endt01 endt02 
                xx judgement enx date lay pt1 pt2 myss ss1 ss2 dst 
             ) 
  (princ "\n批量自动偏移为钢筋=ZDPYWGJ=【海盗曹跬步+27/2013.01.29】") 
  (princ "\n***>>>>>Welcome to 批量自动偏移为钢筋<<<<<***") 
  (setq old_os (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setvar "cmdecho" 0) 
  (setq enx (car (entsel "\n选择操作的图层<退出>:"))) 
  (setq date (entget enx)) 
  (setq lay (cdr (assoc 8 date))) 
  (princ (strcat "\n选中了图层【" lay "】")) 
  (setq pt1 (getpoint "\n请输入第一个角点:")) 
  (setq pt2 (getpoint "\n请输入第二个角点:")) 
  (if (null (setq dst (getdist (strcat "\n输入偏移距离(向内为负,向外为正)<目前为" 
                                       (rtos (getvar "OFFSETDIST") 2 0) ">:" 
                               ) 
                      ) 
            ) 
      ) 
    (setq dst (getvar "OFFSETDIST")) 
    (setvar "OFFSETDIST" dst) 
  ) 
  (setq ss (ssget "_c" pt1 pt2 (list (cons 8 lay) (cons 0 "*line"))) 
        m (sslength ss) 
        n 0 
  ) 
  (command "_undo" "_be") 
  (command "_.ucs" "") 
  (while (< n m) 
    (setq en (ssname ss n)) 
 
    (setq judgement (clockwisep en)) 
    (if (= judgement t) 
      (progn 
        (fx) 
        (setq endt (entget en)) 
        (setq ename (cdr (assoc 0 endt))) 
        (if (member ename (list "XLINE" "RAY")) 
          (progn 
            (setq pt10 (cdr (assoc 10 endt)) 
                  pt11 (cdr (assoc 11 endt)) 
                  ang (atan (/ (cadr pt11) (car pt11))) 
            ) 
            (setq endt01 (subst 
                           (cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10)) 
                           (assoc 10 endt) 
                           endt 
                         ) 
            ) 
            (entmake endt01) 
            (setq endt02 (subst 
                           (cons 10 (polar pt10 (- ang (* 0.5 pi)) 10)) 
                           (assoc 10 endt) 
                           endt 
                         ) 
            ) 
            (entmake endt02) 
          ) 
          (progn 
            (setq obj (vlax-ename->vla-object en)) 
            (vl-catch-all-apply '(lambda (xx) 
                                   (vla-offset xx (- 0 dst)) ; (vla-offset 
                                       ; xx -70) 
                                 ) (list obj) 
            ) 
          ) 
        ) 
      ) 
      (progn 
        (setq endt (entget en)) 
        (setq ename (cdr (assoc 0 endt))) 
        (if (member ename (list "XLINE" "RAY")) 
          (progn 
            (setq pt10 (cdr (assoc 10 endt)) 
                  pt11 (cdr (assoc 11 endt)) 
                  ang (atan (/ (cadr pt11) (car pt11))) 
            ) 
            (setq endt01 (subst 
                           (cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10)) 
                           (assoc 10 endt) 
                           endt 
                         ) 
            ) 
            (entmake endt01) 
            (setq endt02 (subst 
                           (cons 10 (polar pt10 (- ang (* 0.5 pi)) 10)) 
                           (assoc 10 endt) 
                           endt 
                         ) 
            ) 
            (entmake endt02) 
          ) 
          (progn 
            (setq obj (vlax-ename->vla-object en)) 
            (vl-catch-all-apply '(lambda (xx) 
                                   (vla-offset xx (- 0 dst)) ; 
                                       ; (vla-offset xx -70) 
                                 ) (list obj) 
            ) 
          ) 
        ) 
      ) 
    ) 
    (command "_.change" (entlast) "" "p" "la" "rein" "") 
    (setq n (1+ n)) 
  ) 
  (setq ss1 (ssget "_c" pt1 pt2 '((8 . "rein")))) 
  (repeat (sslength ss1) 
    (command "._explode" ss1) 
  ) 
  (setq ss2 (ssget "_c" pt1 pt2 '((8 . "rein")))) 
  (command "_.pedit" "m" "p" "" "y" "w" "30" "") 
  (setvar "osmode" old_os) 
  (command "_.ucs" "_p") 
  (command "_.undo" "_e") 
  (setvar "cmdecho" 1) 
  (princ "\n***>>>>>End of 批量自动偏移为钢筋<<<<<***") 
  (princ) 
)

newer · 发表于 2013-10-25 13:06:55

谢谢，这个版尽量贴出源码。

zhuo2013 · 发表于 2013-10-25 15:29:20

新人入论坛学习顶一下

chxl5878 · 发表于 2014-1-20 14:08:40

看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看看

enn09 · 发表于 2014-4-16 09:45:16

很好的程序，非常实用

火之意志 · 发表于 2014-5-8 10:13:51

不错不错不错不错不错

weehuwei · 发表于 2014-5-21 10:40:39

哇，这个厉害太有用了！

chucklehead · 发表于 2014-8-6 12:44:18

学习学习，谢谢学习学习，谢谢

chucklehead · 发表于 2014-8-6 12:51:04

学习学习，谢谢

宁星宇 · 发表于 2014-8-7 13:35:55

结构新人有福咯

chleiwu · 发表于 2014-8-8 10:05:20

画大样用探索者，能自动按设置数据偏移画钢筋

jyc1118 · 发表于 2014-9-25 15:08:56

这个是在轮廓线内画钢筋的吧

yewuqiang1983 · 发表于 2014-9-28 16:02:09

:):):):):)这个功能很实用，下载了，谢谢

tangsz2006 · 发表于 2014-10-8 22:39:30

画大样的工具

curtian · 发表于 2015-4-16 23:00:58

感谢分享

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

[工具] 自动偏移-适用于画大样钢筋

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

评分