繪製二通程序問題

op90o · 发表于 2016-5-17 18:01

本帖最后由 op90o 于 2016-5-17 20:09 编辑

大家好：
我有個 Gu_xl前輩分享的程序（先謝謝Gu_xl前輩），我將他改良為二通，但是有個問題我不是很明白，想要請教各位前輩如何修正程序。

附上操作畫面，上圖二通可以完成，但是下圖有問題。謝謝指導！

danxingpen · 发表于 2016-5-18 13:41

(defun c:33 ()
  (SETVAR "CMDECHO" 0)
  ;;眔  
  (defun dxf (e i)
(cdr (assoc i (entget e)))
)
  ;; 这个是求最近点的，在直角弯头的时候可用，非直角弯头的时候用起来还是有问题的，所以改用求交点----
  (defun PerToLine (pt p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
      p1 (trans p1 0 norm)
      pt (trans pt 0 norm)
      )
(trans (list (car p1) (cadr p1) (caddr pt)) norm 0)
)
  (command "_undo" "_be")
  (setq cmdecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while (not
         (progn
         (prompt "\n材や恨 :")
         (setq s0 (ssget ":L" '((0 . "line"))))
         (and s0
               (= 2 (sslength s0))
               )
         )
         )
(princ "** **")
)
  (setq e1 (ssname s0 0)
      e2 (ssname s0 1)
      )
  (redraw e1 3)
  (redraw e2 3)
  (while (not
         (progn
         (prompt "\n材や恨 :")
         (setq s1 (ssget ":L" '((0 . "line"))))
         (and s1
               (= 2 (sslength s1))
               )
         )
         )
(princ "** **")
)
  (setq e3 (ssname s1 0)
      e4 (ssname s1 1)
      )
  (redraw e3 3)
  (redraw e4 3)
  (setq p10 (dxf e1 10)
      p11 (dxf e1 11)
p20 (dxf e2 10)
      p21 (dxf e2 11)
      p30 (dxf e3 10)
      p31 (dxf e3 11)
p40 (dxf e4 10)
      p41 (dxf e4 11)
      )
  (setq d1(distance p10 (PerToLine p10 p20 p21));-----
d2(distance p30 (PerToLine p30 p40 p41));-----
d(min d1 d2);变径弯头的话，两个d不一样,取小---
)
  ;直角弯头可以用pertoline应该更方便，为了非直角弯头，采用inter--
  (setq inp13(inters p10 p11 p30 p31 nil)
inp14(inters p10 p11 p40 p41 nil)
      inp23(inters p20 p21 p30 p31 nil)
inp24(inters p20 p21 p40 p41 nil)
)
  ;进行e3和e4的位置确认，内为e3，外为e4---------------
  (if (> (distance p10 inp13)(distance p10 inp14))
(setq tmpp e3
   e3 e4
   e4 tmpp
   tmpp p30
      p30 p40
   p40 tmpp
   tmpp p31
   p31 p41
   p41 tmpp
   )
)
;进行e1和e2的位置确认，内为e1，外为e2---------------
  (if (> (distance p30 inp13)(distance p30 inp23))
(setq tmpp e1
   e1 e2
   e2 tmpp
   tmpp p10
   p10 p20
   p20 tmpp
   tmpp p11
   p11 p21
   p21 tmpp
   )
  )
  (setq r (/ d 2))
  (command "_fillet"
         "r"
         r
         "_fillet"
         (list e1 (trans p10 0 1))
         (list e3 (trans p30 0 1))
         )
  (setq arc1 (entlast))
  (setq r1 (+ d r))
  (command "_fillet"
         "r"
         r1
         "_fillet"
         (list e2 (trans p20 0 1))
         (list e4 (trans p40 0 1))
         )
  (setq arc2 (entlast))
  (setq arcp10(dxf arc1 10))
  (setq lp10(pertoline arcp10 p10 p11))
  (setq lp30(pertoline arcp10 p30 p31))
  (entmake
(list '(0 . "line")
      (cons 10 lp10)
      (cons 11 (pertoline lp10 p20 p21))
      )
)
  (entmake
(list '(0 . "line")
      (cons 10 lp30)
      (cons 11 (pertoline lp30 p40 p41))
      )
)
  (command "_undo" "_end")
  (princ)
  )

op90o · 发表于 2016-5-18 18:12

謝謝 danxingpen前輩熱心解答！

LISP程序試過真的很棒

但是有時候還是會出錯（時好時壞）！
附上測試用DWG檔，研判跟LINE物件有關，LINE若是沒有重疊程序就都沒問題。

danxingpen · 发表于 2016-5-19 09:57

op90o 发表于 2016-5-18 18:12
謝謝 danxingpen前輩熱心解答！
LISP程序試過真的很棒

这个更改了下，现在智能点.

op90o · 发表于 2016-5-19 16:33

真的很感謝 danxingpen前輩！

您真的很熱心，無私分享源碼！

晚輩好好研究一下～
問題我改為以解決了！

zhenghao · 发表于 2016-5-27 13:09

谢谢楼主及danxingpen 好用谢谢

账号		自动登录	找回密码
密码			注册

[已解答] 繪製二通程序問題

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块