水吉空 发表于 2018-11-1 09:10:28

悬赏62个币一起讨论：坛友chenbh2 2012年求助贴：道路交叉打断\\\\\\\\圆角lisp

本帖最后由 水吉空 于 2018-11-2 10:58 编辑


最近看到有个12年的求助贴，发现没解决，自己动手操作了下，发现搞不定:(
一、窗选线条；
二、计算交点；
三、交点打断；
四、删除窗内线条；
五、线条圆角；

原贴地址：http://bbs.mjtd.com/forum.php?mo ... 0%C2%B7%BD%BB%B2%E6
四线打断：实现到第四步删除窗内线条；第五步实现不了。
(defun inter (ent01 ent02 / obj1 obj2)
(setq    obj1(vlax-ename->vla-object ent01)
    obj2(vlax-ename->vla-object ent02)
)
(vlax-invoke obj1 'IntersectWith obj2 acExtendNone)

)
(defun c:jtr (/ cmd ent1 ent2 ent3 ent4 os point1 point2 point3 point4 ss)
(princ "\n请选择要修剪的4个相交物体(直线、圆弧或多段线)...")
(setq ss(ssget '((0 . "LINE,ARC,LWPOLYLINE"))))
(if(=(sslength ss) 4)
   (setq ent1(ssname ss 0)
      ent2(ssname ss 1)
      ent3(ssname ss 2)
      ent4(ssname ss 3)
    )
   (progn
   (princ "\n选取错误，请重新选择4个相交物体!")
   (vl-exit-with-error "")
    )
)
(setq cmd(getvar "cmdecho"))
(setvar "CMDECHO" 0)
(command "undo" "be")
(setq os(getvar "osmode"))
(setvar "osmode" 0)
(setq point1 (inter ent1 ent2))
(if(= point1 nil)
   (progn
   (setq point1 (inter ent1 ent3)
      point2 (inter ent1 ent4)
      point3 (inter ent2 ent3)
      point4 (inter ent2 ent4)
      )
   (command "break" ent1 point1 point2)
   (command "break" ent2 point3 point4)
   (command "break" ent3 point1 point3)
   (command "break" ent4 point2 point4)
    )
   (progn
   (setq point2 (inter ent1 ent3))
   (if(= point2 nil)
   (progn
   (setq    point2 (inter ent1 ent4)
      point3 (inter ent3 ent2)
      point4 (inter ent3 ent4)
      )
   (command "break" ent1 point1 point2)
   (command "break" ent2 point1 point3)
   (command "break" ent3 point3 point4)
   (command "break" ent4 point2 point4)
    )
   (progn
   (setq    point3 (inter ent4 ent2)
      point4 (inter ent4 ent3)
      )
   (command "break" ent1 point1 point2)
   (command "break" ent2 point1 point3)
   (command "break" ent3 point2 point4)
   (command "break" ent4 point3 point4)
    )
      )
    )
)
(setvar "osmode" os)
(command "undo" "e")
(setvar "cmdecho" cmd)
(princ)
)



vectra 发表于 2018-11-1 09:10:29

本帖最后由 vectra 于 2018-11-5 10:25 编辑

关键是要对直线进行分组、排序
楼主看看是否满足要求




水吉空 发表于 2018-11-1 14:22:53

本帖最后由 水吉空 于 2018-11-6 16:54 编辑


;感谢版主踅摸的帮助，经过测试程序还是有问题，来不及研究，先放上来供大家讨论！

(defun inter (ent01 ent02 / obj1 obj2)
(setq obj1 (vlax-ename->vla-object ent01)
    obj2 (vlax-ename->vla-object ent02)
)
(vlax-invoke obj1 'IntersectWith obj2 acExtendNone)
)
(defun midpt (p1 p2)
(mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)
)
(defun c:jtr ()
(if (and (setq pt1 (getpoint "\n窗交选择4个相交物体: "))
          (setq pt2 (getcorner pt1 "\n窗交另一点: "))) (progn
(setq ss(ssget "C" pt1 pt2 '((0 . "LINE,LWPOLYLINE"))))
(if(=(sslength ss) 4) (progn
   (setq ent1(ssname ss 0)
         ent2(ssname ss 1)
         ent3(ssname ss 2)
         ent4(ssname ss 3)
   )
;   (setq cmd (getvar "cmdecho"))
;   (setvar "CMDECHO" 0)
   (command "undo" "be")
   (setq os(getvar "osmode"))
   (setvar "osmode" 0)
   (setq ss1 (ssadd))
   (setq first (entlast))
   (if(= (setq point1 (inter ent1 ent2)) nil) (progn
    (setq point1 (inter ent1 ent3)
          point2 (inter ent1 ent4)
          point3 (inter ent2 ent3)
          point4 (inter ent2 ent4)
    )
    (command "break" ent1 point1 point2)
    (command "break" ent2 point3 point4)
    (command "break" ent3 point1 point3)
    (command "break" ent4 point2 point4)
   ) (if(= (setq point2 (inter ent1 ent3)) nil) (progn
   (setq point2 (inter ent1 ent4)
         point3 (inter ent3 ent2)
         point4 (inter ent3 ent4)
   )
   (command "break" ent1 point1 point2)
   (command "break" ent2 point1 point3)
   (command "break" ent3 point3 point4)
   (command "break" ent4 point2 point4)
    ) (progn
   (setq point3 (inter ent4 ent2)
         point4 (inter ent4 ent3)
   )
   (command "break" ent1 point1 point2)
   (command "break" ent2 point1 point3)
   (command "break" ent3 point2 point4)
   (command "break" ent4 point3 point4)
    ))
   )
   (setq pm (midpt pt1 pt2))
   (setq pt3 (list (car pt1) (cadr pt2)))
   (setq pt4 (list (car pt2) (cadr pt1)))
   (setvar "FILLETRAD" 100)
   (repeat (setq i 4)
    (setq pt (eval(read(strcat "pt" (itoa i)))))
    (setq ss (ssget "C" pt pm '((0 . "LINE,LWPOLYLINE"))))
    (setq en1 (ssname ss 0) en2 (ssname ss 1))
    (setq ent1 (entget en1))
    (setq pm1 (midpt (cdr(assoc 10 ent1)) (cdr(assoc 11 ent1))))
    (setq ent2 (entget en2))
    (setq pm2 (midpt (cdr(assoc 10 ent2)) (cdr(assoc 11 ent2))))
    (command "_.FILLET" pm1 pm2)
    (setq i (1- i))
   )
   (command "UNDO" "E")
)
   (princ "\n选取错误，请重新选择4个相交物体!")
)
))
(princ)
)

根据vectra大神提供的源码自己改了下，改为多段线然后想改为通用型的，搞了一天，只出了一个半成品，实在搞不动了。其他的很多问题还是没能解决，就贴个自己的半成品成果吧，希望有大神优化。

ysq101 发表于 2018-11-2 00:10:45

这奖励都没有大师出手？？？

烟盒迷唇 发表于 2018-11-2 08:09:55

大师都没起床，再等等吧

ssyfeng 发表于 2018-11-2 09:15:58

倒圆角就CAD本身的功能都不完美，要突破桌子公司比较难啊

水吉空 发表于 2018-11-2 09:18:44

ssyfeng 发表于 2018-11-2 09:15
倒圆角就CAD本身的功能都不完美，要突破桌子公司比较难啊

是啊，所以有的思路是直接画圆弧。

bluefcc1 发表于 2018-11-2 10:10:58

這一篇可參考
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=88723&highlight=%B5%B9%BD%C7

水吉空 发表于 2018-11-2 10:57:20

bluefcc1 发表于 2018-11-2 10:10
這一篇可參考
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=88723&highlight=%B5%B9%BD%C7

谢谢 。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

panliang9 发表于 2018-11-4 13:27:49

道路的要求还比这个复杂一些，在非直角的交叉口，圆角的半径参数是不一样的！
页: [1] 2
查看完整版本: 悬赏62个币一起讨论：坛友chenbh2 2012年求助贴：道路交叉打断\\\\\\\\圆角lisp