[测试大家的模仿能力]我写的连续偏移命令

gbhsu

对，哪个能做成批量偏移的？

VBALISPER

唉,最近一周都要加班,没有时间静下来学习,遗憾.

gbhsu

要发源码了
还不要钱
大家快顶呀

lrd1861

有这好事 顶起来

1993063

有这好事,俺来也

gbhsu

今天贴个最初的源码
只支持直线，可以更简单的，但我不想再改了
改天再贴支持所有对象的
大家拍砖，欢迎有更好的出现
(defun c:o-(/ s en ent dist ang pt1 pt2 ptmid odist midptlist minmaxlist minpt maxpt sslist)
  (setq dist (getdist (strcat"\n指定偏移距离或[通过(T)]<" (rtos (setq odist(abs(getvar 'offsetdist)))) ">:")))
  (if (not dist)(setq dist odist))
  (setq s(entsel) midptlist (list) sslist (list))
  (if s(setq en (car s)))
  (while (and en(setq pt (getpoint "\n指定点以确定偏移所在一侧:")))
          (setq
                ent (entget en)
                name(cdr(assoc 0 ent))
                pt1(cdr(assoc 10 ent))
                pt2(cdr(assoc 11 ent))
                ang (angle pt1 pt2)
                ptmid(mapcar '(lambda (a b) (* (+ a b) 0.5)) pt1 pt2)
                midptlist(append (list ptmid) midptlist)
                minmaxlist(cmdX:GetExtents midptlist)
                minpt(car minmaxlist)
                maxpt(cadr minmaxlist)
                pt90(inters minpt maxpt pt (polar pt ang 100)nil)
                );setq
        
        (if (=(length midptlist)1)
            (progn
         (setq sslist(append sslist(list en)))
         (command ".offset" dist en pt "")
         (setq en (entlast))
         (setq pt90(inters ptmid (polar ptmid (+ ang (* 0.5 pi))100) pt (polar pt ang 100)nil))
         (setq ptmid(polar ptmid (angle ptmid pt90)dist)
               midptlist(append (list ptmid) midptlist)
               minmaxlist(cmdX:GetExtents midptlist)
               minpt(car minmaxlist)
               maxpt(cadr minmaxlist))
         (redraw en 3)
         (if(<(distance ptmid maxpt)(distance ptmid minpt))
                    (setq sslist(append sslist(list en)))
                    (setq sslist(append (list en)sslist)))
         
         (setq pt90 nil)
         );progn
        );if
      (if(and pt90 (not(inters minpt maxpt pt pt90 t))(>(length midptlist)2))  
         (progn
         (redraw en 4)
         (if(<(distance pt90 maxpt)(distance pt90 minpt))
            (setq en (last sslist))
            (setq en(car sslist)))
         (command ".offset" dist en pt "")
         (setq en (entlast))
        (if(<(distance pt90 maxpt)(distance pt90 minpt))
                    (setq sslist(append sslist(list en)))
                    (setq sslist(append (list en)sslist)))
         (redraw en 3)
         );progn
        );if
    );while
   (redraw en 4)
   (princ)
);defun


(defun cmdX:GetExtents (plist /)
  (list
    (apply 'mapcar (cons 'min plist))
    (apply 'mapcar (cons 'max plist))
  )
)

cnks

很少这样偏移吧，这样的话不如阵列来的方便
单纯从lisp编程上还是支持的

gbhsu

虽然写得不好
但思路还是不错的哦
对于学习编程的朋友研究一下还是可以的
几位大师也可以开始贴源码了呀

1993063

呵呵,这个和单向阵列差别不是很大,不过画大小孔的很方便要是来个动态的更爽!

革天明

yjr111 发表于 2011-10-26 02:04
有一点小成果，先发上来献献丑吧。。。。。

这个看效果很好看，有空我也试着写一个