请各位高手帮帮实现一个小工具（绘制车边镜）
本帖最后由 raimo 于 2012-3-6 20:32 编辑因为搞建筑室内图纸，经常需要绘制车边镜，这个过程简单但是很繁琐，尤其是比较复杂一点的分隔。
所以想请坛里的高手们能帮个小忙。。
关于这个工具的实现方式，我是这样考虑的（仅供参考）
1. 点选范围内一点，自动生成内偏移边界线（可指定偏移量，例如15mm）
2.在每个转折处绘制45° 短直线，长度=延伸至刚才点取的范围线
3.颜色与线形都随层，将新生成的线转换为一个整体（PLine 或 组起来 ）
4.然后继续等待下次点击，右键取消
思路范图如下
先在这里多谢了！！
看你上面的图不是正在使用这样的程序了么？为什么还要？ 呃。。。上面的是我自己假想的程序效果演示。。所以才求能实现这个想法
;画车边镜 明经 ZZXXQQ 2012.3.6
(defun c:tt ()
(setvar "CMDECHO" 0)
(setq i 1)
(while (setq pt (getpoint "\n选取矩形内一点 :"))
(setq ss (ssadd))
(command "BPOLY" pt "")
(setq en1 (entlast))
(setq ent1 (entget en1))
(command ".OFFSET" 15 (list en1 (cdr(assoc 10 ent1))) pt "")
(entdel en1)
(setq en2 (entlast) ent2 (entget en2) ss (ssadd en2 ss))
(setq ptl (list))
(foreach x ent2 (if (= (car x) 10) (setq ptl (cons(cdr x) ptl))))
(setq pt1 (list (eval(cons 'min (mapcar 'car ptl)))
(eval(cons 'min (mapcar 'cadr ptl))) 0))
(setq pt2 (list (eval(cons 'max (mapcar 'car ptl)))
(eval(cons 'max (mapcar 'cadr ptl))) 0))
(entmake
(list
'(0 . "LINE")
(cons 10 pt1)
(cons 11 (mapcar '+ pt1 '(-15 -15 0)))
)
)
(ssadd (entlast) ss)
(entmake
(list
'(0 . "LINE")
(cons 10 pt2)
(cons 11 (mapcar '+ pt2 '(15 15 0)))
)
)
(ssadd (entlast) ss)
(entmake
(list
'(0 . "LINE")
(cons 10 (setq pt3 (list (car pt1) (cadr pt2) 0)))
(cons 11 (mapcar '+ pt3 '(-15 15 0)))
)
)
(ssadd (entlast) ss)
(entmake
(list
'(0 . "LINE")
(cons 10 (setq pt4 (list (car pt2) (cadr pt1) 0)))
(cons 11 (mapcar '+ pt4 '(15 -15 0)))
)
)
(ssadd (entlast) ss)
(command "-GROUP" "C" (strcat "A" (itoa i)) "" ss "")
(setq i (1+ i))
)
(princ)
)
本帖最后由 langjs 于 2012-3-7 00:55 编辑
晕，Z版写了一个，我也写了一个。楼主到处发消息找人帮忙……
既然写了，就贴上来吧。
(defun c:zz (/ ent list1 list2 long lst name name1 pt s x y)
(defun zz01 (ent / lst x)
(foreach x ent
(if (= (car x) 10)(setq lst (cons (cdr x) lst)) )
)
lst
)
(setvar "CMDECHO" 0)
(if (null jbak) (setq jbak 15.0))
(if (setq s (getint (strcat "\n设置偏移距离:<" (rtos jbak) ">"))) (setq jbak s) )
(setq long (rtos (* jbak 2 (sin (* 45 (/ pi 180)))) 2 4))
(while (setq pt (getpoint "\n指定点 :"))
(command ".UNDO" "BE")
(command "BPOLY" pt "")
(setq name (entlast) list1 (zz01 (entget name)))
(command "OFFSET" jbak name pt "")
(setq name1 (entlast) list2 (zz01 (entget name1)))
(entdel name)
(foreach x list2
(foreach y list1
(if (= (rtos (distance x y) 2 4) long)(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 10 x) (cons 11 y))))
)
)
(command ".UNDO" "E")
)
(princ)
)
本帖最后由 raimo 于 2012-3-7 22:05 编辑
我是很想要这样一个小工具，所以给两位高手发了求助。
而且是很快就得到了 Z版和langjs的帮助！！非常感谢！！
试用过后发现
Z版的程序处理完之后线段可以自己成组，方便后期选择与编辑，
但是在处理非矩形的异形边界的时候会画错短斜线，
langjs 的程序处理各种边界很完美，
就是不能成组或块，这样如果需要后期编辑，太多短线很不好选择
如果二位的程序中和一下就更好了。
好帖子，mark 本帖最后由 xotoo 于 2012-3-8 13:17 编辑
不错不错
Z版的在一些转角处会有一点小问题
见下图
本帖最后由 langjs 于 2012-3-8 22:04 编辑
论坛里找了一些源码给你完善一下
(defun c:zz (/ char-02 char-1 ent i lay lays list1 list2 long lst name name1 pt pt1 s snap ss uuu x y)
(vl-load-com)
(defun zz01 (ent / lst x)
(foreach x ent
(if (= (car x) 10)
(setq lst (cons (cdr x) lst))
)
)
lst
)
(setvar "CMDECHO" 0)
(command "_.purge" "B" "" "n")
(if (null jbak)
(setq jbak 15.0)
)
(setq lay nil)
(while (setq lay (tblnext "block" (not lay)))
(setq lays (append
lays
(list (cdr (assoc 2 lay)))
)
)
)
(setq uuu 0
i 0
)
(while (< i (length lays))
(setq char-02 (nth i lays))
(if (= (substr char-02 1 4) "区域")
(progn
(if (> (atoi (substr char-02 5)) uuu)
(setq uuu (atoi (substr char-02 5)))
)
)
)
(setq i (1+ i))
)
(while (progn
(while (progn
(initget "S ")
(if (= (setq pt (getpoint (strcat "\n指定内部点,或[设置(S)]:<偏移距离" (rtos jbak) ">")))
"S"
)
(if (setq s (getreal (strcat "\n设置偏移距离:<" (rtos jbak) ">")))
(setq jbak s)
)
)
(if (null pt)
(vl-exit-with-error "")
)
(or
(= pt "S")
(not (= (type pt) 'list))
)
)
)
(= (type pt) 'list)
)
(command ".UNDO" "BE")
(setq snap (getvar "osmode"))
(setvar "osmode" 0)
(command "BPOLY" pt "")
(setq name (entlast)
list1 (zz01 (entget name))
ss (ssadd)
)
(command "OFFSET" jbak name pt "")
(setq name1 (entlast)
list2 (zz01 (entget name1))
)
(ssadd name1 ss)
(entdel name)
(foreach x list2
(setq long 1e6)
(foreach y list1
(if (< (distance x y) long)
(setq pt1 y
long (distance x y)
)
)
)
(entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 10 x) (cons 11 pt1)))
(ssadd (entlast) ss)
)
(setq char-1 (strcat "区域" (itoa (setq uuu (1+ uuu)))))
(command "block" char-1 pt ss "")
(command "INSERT" char-1 pt 1 1 0)
(setvar "osmode" snap)
(command ".UNDO" "E")
)
(princ)
)
langjs
太好了，这个程序很棒！！！顶你