框选进行批量倒圆

dyzf1314 · 发表于 2012-4-23 20:32:42

本帖最后由 dyzf1314 于 2012-4-23 20:56 编辑

xiaxiang 发表于 2012-4-23 15:45
依楼主附图来看
可以试一下如下代码

晚上回家再试了下，对于下图的中选择其中的一个图形可以实现批量倒圆，

但是附件DWG文件不知道为什么，不能实现批量的操作，单独的红色或者黑色部分的都可以实现批量操作，
但如果一起选中，CAD报错如下，能解决吗？

Command: xlx
半径：150
Select objects: Specify opposite corner: 10 found
Select objects: ; error: bad argument type: 2D/3D point: nil

另外，我想问下，如果在全部倒好圆的图形，能否再次运行lisp，把倒圆角的数值改为0，再恢复到初始的图形呢？

dyzf1314 · 发表于 2012-4-23 20:59:56

本帖最后由 dyzf1314 于 2012-4-23 21:01 编辑

【KAIXIN】发表于 2012-4-23 19:38
怎么是多谢我呢？

帮忙看看我上面的问题？？

induh62662 · 发表于 2012-4-24 00:15:51

我怀疑楼主用的是金山快译且额外附带了中对中翻译。

fdb2007 · 发表于 2012-4-24 08:08:27

明经论坛上的朋友很无私啊，让我们这些新手学到了很多，不过自己技术底子差，为论坛做不了什么，惭愧

xiaxiang · 发表于 2012-4-24 14:34:07

对程序进行了重写

;出错处理
(defun err (s)
(if (and (/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn
(setvar "osmode" oldos)
(setvar "autosnap" oldosn)
(setvar "orthomode" oldor)
(setq *error* olderr)
(command "_.undo" "e")
(setvar "cmdecho" oldcmd)
(princ (strcat "\n程序出错或用户退出:" s))
)
)
)
;;;备份系统变量
(defun bak ()
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "be")
(setq oldos (getvar "osmode")
oldosn (getvar "autosnap")
oldor (getvar "orthomode")
olderr *error*
*error* err
)
)
;;恢复系统变量
(defun rebak ()
(setvar "osmode" oldos)
(setvar "autosnap" oldosn)
(setvar "orthomode" oldor)
(setq *error* olderr)
(command "_.undo" "e")
(setvar "cmdecho" oldcmd)
)
;求交点集函数－nth
;;经过测试，nth函数仅比assoc函数快一点点。
;;故此函数也可取消i，j变量，直接使用assoc函数
(defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j)
(setq outlst (mapcar 'list el)
i -1 ;obj1位置指针
n 0 ;交点数计数器
)
(while el
(setq obj1 (car el)
list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表
el (cdr el)
el1 el
j i ;obj2位置指针
)
(while el1
(setq obj2 (car el1)
el1 (cdr el1)
j (1+ j)
)
;;取交点
(if (and (setq ipts (vla-intersectwith obj1 obj2 0))
(setq ipts (vlax-variant-value ipts))
(> (vlax-safearray-get-u-bound ipts 1) 0)
)
(progn
(setq ipts (vlax-safearray->list ipts)
pts '() ;obj1,obj2交点临时列表变量
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
(setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新
n (+ n (length pts)) ;交点计数累加
)
;;obj2的交点列表立即更新
(setq
outlst (subst (append (nth j outlst) pts)
(nth j outlst)
outlst
)
)
)
)
)
;| ;;当obj1存在交点，且非封闭曲线，添加两端点
(if (and (cdr list1) (not (vlax-curve-isClosed obj1)))
(setq list1 (append list1
(list (vlax-curve-getEndPoint obj1))
(list (vlax-curve-getStartPoint obj1))
)
)
)
(setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表 |;
)
outlst
)
;;点集排序及删除重复点函数
(defun InterSort (el / obj1 pts plst outlst)
(setq outlst '()) ;empty list
(foreach item el
(setq obj1 (car item)
pts (cdr item)
plst '() ;empty list
)
(if pts ;若无交点，则不修改该实体
(progn
;;交点排序，列表为逆序
(setq
pts (vl-sort
pts
(function (lambda (p1 p2)
(< (vlax-curve-getParamAtPoint obj1 p1)
(vlax-curve-getParamAtPoint obj1 p2)
)
)
)
)
)
;;剔除重复点并将列表顺序转正
(foreach p pts
(if plst
(if (not (equal p (car plst) 0.00001))
(setq plst (cons p plst))
)
(setq plst (cons p plst))
)
)
;;闭合曲线需再添加首个交点以使新实体完全封闭
(if (vlax-curve-isClosed obj1)
(setq plst (cons (last plst) plst))
)
(setq plst (cons (vlax-vla-object->ename obj1) plst)
outlst (cons plst outlst)
)
)
)
)
outlst
)
;;计算耗时
(defun xdl-getutime ()
(* 86400 (getvar "tdusrtimer"))
)
;; 清理当前选择集
(defun Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset (vl-catch-all-apply 'vla-item (list(vlax-get-property (vlax-get-property (vlax-get-acad-object) 'activedocument ) 'selectionsets)"CURRENT")))
)
)
(vla-delete cset)
)
(princ)
)
(defun c:xlx( / elist ssg n t0)
(VL-LOAD-COM)
(setq pt_list1 '())
(setq r (getreal (strcat "请输入倒角半径<" (rtos (getvar "filletrad"))
">"
)
)
)
(if (null r)
(setq r (getvar "filletrad"))
(setvar "filletrad" r)
)
;(setq ss (ssget '((0 . "line"))))
(bak)
(clearcset)
(if (setq ssg (ssget '((0 . "line"))))
(vlax-for obj (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(setq elist (cons obj elist)) ; ssg->elist
)
(vlax-release-object obj)
)
(setq t0 (xdl-getutime))
(setq pt_list(InterSort (ssinter elist)))
(foreach pt pt_list
(setq pt_list1 (append (cdr pt)pt_list1))
)
(foreach pt pt_list1
;(setq pt (cadr pt))
(progn
(setq ss2 (ssget "c" pt pt))
(setq en1 (ssname ss2 0))
(setq en2 (ssname ss2 1))
(if (and en1 en2)(command "fillet" en1 en2))
)
)
(rebak)
(princ (strcat "\n*****找到交点"
(itoa n)
"个，交点倒角操作操作共耗时"
(rtos (- (xdl-getutime) t0) 2 3)
"秒。*****"
)
)
(princ)
(prompt "<<xlx>>相连线批量倒角")
)
(prompt "<<xlx>>相连线批量倒角")
(princ)

;出错处理 
 (defun err (s) 
   (if (and (/= s "console break") 
      (/= s "Function cancelled") 
      (/= s "quit/exit abort") 
    ) 
  (progn 
    (setvar "osmode" oldos)      
    (setvar "autosnap" oldosn) 
    (setvar "orthomode" oldor) 
    (setq *error* olderr) 
    (command "_.undo" "e") 
     (setvar "cmdecho" oldcmd) 
    (princ (strcat "\n程序出错或用户退出:" s)) 
  ) 
   ) 
 ) 
 ;;;备份系统变量 
 (defun bak () 
   (setq        oldcmd        (getvar "cmdecho")) 
   (setvar "cmdecho" 0) 
   (command "_.undo" "be") 
   (setq        oldos        (getvar "osmode") 
   oldosn (getvar "autosnap") 
   oldor (getvar "orthomode")         
   olderr        *error* 
   *error*        err 
   ) 
 ) 
 ;;恢复系统变量 
 (defun rebak () 
   (setvar "osmode" oldos)   
   (setvar "autosnap" oldosn) 
   (setvar "orthomode" oldor) 
   (setq *error* olderr) 
   (command "_.undo" "e") 
   (setvar "cmdecho" oldcmd) 
 ) 
 ;求交点集函数－nth 
 ;;经过测试，nth函数仅比assoc函数快一点点。 
 ;;故此函数也可取消i，j变量，直接使用assoc函数 
 (defun ssinter (el / el1 obj1 obj2 ipts pts list1 outlst i j) 
   (setq outlst (mapcar 'list el) 
  i      -1   ;obj1位置指针 
  n      0   ;交点数计数器 
   ) 
   (while el 
  (setq obj1 (car el) 
    list1 (nth (setq i (1+ i)) outlst) ;obj1已有的交点列表 
    el (cdr el) 
    el1 el 
    j i   ;obj2位置指针 
  ) 
  (while el1 
    (setq obj2 (car el1) 
   el1  (cdr el1) 
   j  (1+ j) 
    ) 
    ;;取交点 
    (if (and (setq ipts (vla-intersectwith obj1 obj2 0)) 
   (setq ipts (vlax-variant-value ipts)) 
   (> (vlax-safearray-get-u-bound ipts 1) 0) 
    ) 
  (progn 
    (setq ipts (vlax-safearray->list ipts) 
   pts  '()  ;obj1,obj2交点临时列表变量 
    ) 
    (while (> (length ipts) 0) 
   (setq pts  (cons (list (car ipts) 
     (cadr ipts) 
     (caddr ipts) 
   ) 
   pts 
    ) 
  ipts (cdddr ipts) 
   ) 
    ) 
    (setq list1 (append list1 pts) ;存obj1交点表，循环结束后再更新 
   n     (+ n (length pts)) ;交点计数累加 
    ) 
    ;;obj2的交点列表立即更新 
    (setq 
   outlst (subst (append (nth j outlst) pts) 
   (nth j outlst) 
   outlst 
   ) 
    ) 
  ) 
    ) 
  ) 
;|   ;;当obj1存在交点，且非封闭曲线，添加两端点 
  (if (and (cdr list1) (not (vlax-curve-isClosed obj1))) 
    (setq list1 (append list1 
   (list (vlax-curve-getEndPoint obj1)) 
   (list (vlax-curve-getStartPoint obj1)) 
  ) 
    ) 
  ) 
  (setq outlst (subst list1 (nth i outlst) outlst)) ;更新obj1交点列表 |; 
   ) 
   outlst 
 ) 
 ;;点集排序及删除重复点函数 
 (defun InterSort (el / obj1 pts plst outlst) 
   (setq outlst '())   ;empty list 
   (foreach item el 
  (setq obj1 (car item) 
    pts  (cdr item) 
    plst '()   ;empty list 
  ) 
  (if pts    ;若无交点，则不修改该实体 
    (progn 
  ;;交点排序，列表为逆序 
  (setq 
    pts (vl-sort 
   pts 
   (function (lambda (p1 p2) 
     (< (vlax-curve-getParamAtPoint obj1 p1) 
     (vlax-curve-getParamAtPoint obj1 p2) 
     ) 
   ) 
   ) 
     ) 
  ) 
  ;;剔除重复点并将列表顺序转正 
  (foreach p pts 
    (if plst 
   (if (not (equal p (car plst) 0.00001)) 
     (setq plst (cons p plst)) 
   ) 
   (setq plst (cons p plst)) 
    ) 
  ) 
  ;;闭合曲线需再添加首个交点以使新实体完全封闭 
  (if (vlax-curve-isClosed obj1) 
    (setq plst (cons (last plst) plst)) 
  ) 
  (setq plst   (cons (vlax-vla-object->ename obj1) plst) 
     outlst (cons plst outlst) 
  ) 
    ) 
  ) 
   ) 
   outlst 
 ) 
 ;;计算耗时 
 (defun xdl-getutime () 
   (* 86400 (getvar "tdusrtimer")) 
 ) 
 ;; 清理当前选择集 
 (defun Clearcset (/ cset) 
  (if (not (vl-catch-all-error-p      
  (setq cset (vl-catch-all-apply 'vla-item (list(vlax-get-property (vlax-get-property (vlax-get-acad-object) 'activedocument ) 'selectionsets)"CURRENT"))) 
      )       
    )    
  (vla-delete cset)   
  ) 
  (princ) 
  ) 
   
(defun c:xlx( / elist ssg n t0) 
   (VL-LOAD-COM) 
   (setq pt_list1 '()) 
   (setq r (getreal (strcat "请输入倒角半径<" (rtos (getvar "filletrad")) 
         ">" 
        ) 
      ) 
   ) 
   (if (null r) 
    (setq r (getvar "filletrad")) 
    (setvar "filletrad" r) 
  ) 
  ;(setq ss (ssget '((0 . "line")))) 
  (bak) 
  (clearcset) 
  (if (setq ssg (ssget '((0 . "line")))) 
    (vlax-for obj (vla-get-activeselectionset 
      (vla-get-activedocument (vlax-get-acad-object)) 
    ) 
      (setq elist (cons obj elist)) ; ssg->elist 
    ) 
 (vlax-release-object obj) 
  ) 
  (setq t0 (xdl-getutime)) 
  (setq pt_list(InterSort (ssinter elist))) 
  (foreach pt pt_list 
  (setq pt_list1 (append (cdr pt)pt_list1)) 
  ) 
  (foreach pt pt_list1 
  ;(setq pt (cadr pt)) 
    (progn 
      (setq ss2 (ssget "c" pt pt)) 
        (setq en1 (ssname ss2 0)) 
    (setq en2 (ssname ss2 1)) 
        (if (and en1 en2)(command "fillet" en1 en2)) 
      ) 
    ) 
 (rebak) 
 (princ (strcat "\n*****找到交点" 
   (itoa n) 
   "个，交点倒角操作操作共耗时" 
   (rtos (- (xdl-getutime) t0) 2 3) 
   "秒。*****" 
  ) 
  ) 
  (princ) 
  (prompt "<<xlx>>相连线批量倒角") 
  ) 
  (prompt "<<xlx>>相连线批量倒角") 
  (princ)

xiaxiang · 发表于 2012-4-24 14:38:24

另外，我想问下，如果在全部倒好圆的图形，能否再次运行lisp，把倒圆角的数值改为0，再恢复到初始的图形呢？

针对这个问题前面有帖子进行过讨论。除非对生成的圆弧进行标记，不然逆向容易出错！
如无必要，可以不做这种尝试。

aaacjh · 发表于 2012-6-10 16:21:31

xiaxiang 发表于 2012-4-23 15:45
依楼主附图来看
可以试一下如下代码

这个实用，顶起！

xiaxiang · 发表于 2012-6-10 16:25:38

aaacjh 发表于 2012-6-10 16:21
这个实用，顶起！

呵呵，刚好在线，说两句。
其实这个并不是完美的程序，处理复杂的三维投影会出错的！
完美版本不便公开罢了。。。

zhaozwf · 发表于 2012-6-17 09:10:43

能不能实现这样的，假如说第一次倒角2，想修改一下倒角半径，比如说0 或者是4，运行一下程序，重新输入半径，可以实现圆角变为0或者4，另，能不能加入对多义线的支持

王航 · 发表于 2012-8-14 14:40:53

xiaxiang 发表于 2012-4-24 14:34
对程序进行了重写

能不能加入对多义线的支持

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

框选进行批量倒圆

本帖子中包含更多资源

点评

评分

点评

浏览过的版块