请各位高手帮帮实现一个小工具（绘制车边镜）

raimo

因为搞建筑室内图纸，经常需要绘制车边镜，这个过程简单但是很繁琐，尤其是比较复杂一点的分隔。
所以想请坛里的高手们能帮个小忙。。

关于这个工具的实现方式，我是这样考虑的（仅供参考）
1. 点选范围内一点，自动生成内偏移边界线（可指定偏移量，例如15mm）
2.在每个转折处绘制45° 短直线，长度=延伸至刚才点取的范围线
3.颜色与线形都随层，将新生成的线转换为一个整体（PLine 或 组起来 ）
4.然后继续等待下次点击，右键取消

思路范图如下




先在这里多谢了！！

langjs

看你上面的图不是正在使用这样的程序了么？为什么还要？

raimo

呃。。。上面的是我自己假想的程序效果演示。。所以才求能实现这个想法

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

langjs

晕，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

我是很想要这样一个小工具，所以给两位高手发了求助。
而且是很快就得到了 Z版和langjs的帮助！！非常感谢！！

试用过后发现
Z版的程序处理完之后线段可以自己成组，方便后期选择与编辑，
但是在处理非矩形的异形边界的时候会画错短斜线，

langjs 的程序处理各种边界很完美，
就是不能成组或块，这样如果需要后期编辑，太多短线很不好选择

如果二位的程序中和一下就更好了。

革天明

好帖子，mark

xotoo

不错不错
Z版的在一些转角处会有一点小问题
见下图

langjs

论坛里找了一些源码给你完善一下
(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)
)

vlisp2012

langjs
太好了，这个程序很棒！！！顶你