连接线段或者填充

love1030312

多话不说  直接上要求   如图  在CAD里边怎么样能达到这中效果，把填充的格子线在一个图像里连成2根，一根更好， 只要达到最终的效果  ， 直接填充或者填充好格子后连接 怎么样都行 （红线和黄线只是为了看起来清晰些，没有要求） 请论坛的大大  版主   高手们帮我看看 写个程序 谢谢

langjs

试试，圆角无法识别，用直线直接连了。


;;; 填充连线
;;;                by:langjs
(defun c:zz (/ ent i j lst lst1 lst2 pt1 pt2 ss)
  (defun draw (lst / i lst1)
    (setq i 0  lst1 '())
    (repeat (length lst)
      (setq lst1 (append lst1(if (= (rem i 2) 0)(nth i lst)(reverse (nth i lst)))))
      (setq i (1+ i))    )
    (entmake (append
               (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst1)))
               (mapcar '(lambda (i) (cons 10 i)) lst1 )))
  )
  (setq ent (car (entsel "\n选择填充：")))
  (command ".explode" ent)
  (setq ss (ssget "p")        lst1 '() lst2 '())
  (repeat (setq i (sslength ss))
    (setq ent (entget (ssname ss (setq i (1- i))))
          pt1 (cdr (assoc 10 ent))  pt2 (cdr (assoc 11 ent)))
    (if (= (car pt1) (car pt2))
      (if (< (cadr pt1) (cadr pt2))(setq lst1 (cons (list pt1 pt2) lst1))(setq lst1 (cons (list pt2 pt1) lst1)))
      (if (< (car pt1) (car pt2))(setq lst2 (cons (list pt1 pt2) lst2))        (setq lst2 (cons (list pt2 pt1) lst2)))
    ))
  (setq lst1 (vl-sort lst1 (function (lambda (i j)(< (car (car i)) (car (car j)))))))
  (setq lst2 (vl-sort lst2 (function (lambda (i j)(< (cadr (car i)) (cadr (car j)))))))
  (draw lst1)
  (draw lst2)
  (command ".erase" ss "")
  (princ)
)

langjs

这个东西是干啥的？很奇怪的功能

love1030312

langjs 发表于 2014-6-16 01:20
这个东西是干啥的？很奇怪的功能

雕刻走线的   这样之后可以节约3分之2的时间   
   谢谢大大

love1030312

love1030312 发表于 2014-6-16 08:05
雕刻走线的   这样之后可以节约3分之2的时间   
   谢谢大大

能  没事  非常好用 我测量了 下虽然没有圆弧 但是误差也很小  在我们行业 那点误差  可以无视掉   谢谢

xyp1964

love1030312

xyp1964 发表于 2014-6-16 14:12

感谢院长   还是院长给力啊

GDFGFGF

要是能框选就好了，

GDFGFGF

能做个框选的吗，我愿付费。

GDFGFGF

QQ:1390935671