动态延升直线或圆弧

zcsoft · 发表于 2015-2-11 09:57

本帖最后由 zcsoft 于 2015-2-11 10:29 编辑

五年时间没玩LISP了，年末快要放假了，腾出点时间狂狂论坛，看到不少朋友晒源码，俺也贴出俺以前的自己做的源码与大家分享！

这个最初也是在天河CAD那看到的，就自己做了一个，功能完全达到天河的功能，且还多了一个好玩的东东，不过这个多出的东东无实际用途

这个程序的核心函数为：grread

(defun c:ff ( / ka01 pt1 KENT KENTLIST karc knea ka1 ka2 ka3 ka4 klj pt11 )
  (setq ka01 (entsel "请选择直线或圆弧:"))(if ka01
(progn(setq  KENT (car ka01))(setq KENTLIST (entget KENT))
(if(not(or(eq "ARC" (cdr(assoc 0 KENTLIST)))(eq "LINE" (cdr(assoc 0 KENTLIST)))))
(princ "\n您选择的不是直线或圆弧!")       (progn(princ "\n按右键显示路径.")
  (setq pt1 (cadr ka01))(setq  KENT (car ka01))(setq KENTLIST (entget KENT))
  (if (eq "ARC" (cdr(assoc 0 KENTLIST)))(setq karc t)(setq karc nil))
  (setq ka1 (vlax-ename->vla-object KENT))
  (if (<(distance pt1 (vlax-curve-getStartPoint ka1))(distance pt1
      (vlax-curve-getEndPoint ka1)))(setq knea t)(setq knea nil))
  (while ka1
(setq ka2 (grread t 12 2) ka3 (car ka2)  ka4 (cadr ka2))
   (if (= ka3 25)(if klj(setq klj nil)(setq klj t)))
(cond ((= ka3 5)
         (progn (setq pt11 (vlax-curve-getClosestPointTo ka1 ka4 t))
(if(not karc)(if knea
               (if (> (distance pt11 (vlax-curve-getEndPoint ka1)) 0.1)
               (vla-put-StartPoint ka1 (vlax-3d-point pt11)))
               (if(> (distance pt11 (vlax-curve-getStartPoint ka1)) 0.1)
      (vla-put-EndPoint ka1 (vlax-3d-point pt11)))
               )
      (if knea(vlax-put-property ka1 'StartAngle (angle (cdr(assoc 10 KENTLIST))pt11))
         (vlax-put-property ka1 'EndAngle (angle (cdr(assoc 10 KENTLIST))pt11))))
                  (if klj (progn(redraw)(grdraw ka4 pt11 2 4)))
                  )
         )
      ((= ka3 3)(setq ka1 nil))
      ;((= ka3 25)(princ ka3)(princ ka4))
      ;(t (princ ka2)(princ "  "))
      ;(t (princ ka3)(princ ",")(princ ka4)(princ " "))
      )) )) )) (redraw) (princ)
)

asen · 发表于 2018-8-4 08:48

(command "_.lengthen" "dy")

灰色头像2 · 发表于 2020-9-10 11:16

以前的宝贝都这么牛
现在的就
更牛了哈

20060510412 · 发表于 2018-10-25 20:55

贱人工具箱里面不是也有这个功能么

lz123456 · 发表于 2015-2-11 11:02

看下精品，谢谢

szx025 · 发表于 2015-2-11 11:08

kkkkkkkkkkkkkk

819534890 · 发表于 2015-2-11 11:10

支持源码。

aihuyujian · 发表于 2015-2-11 11:24

源码必须支持

ucuc2003 · 发表于 2015-2-11 11:32

回复一下，看看隐藏了什么东东

ynhh · 发表于 2015-2-11 11:37

以前的宝贝都这么牛
现在的就
更牛了哈

yangist · 发表于 2015-2-11 11:47

看看~~~~~~~~~~~~~~~~~~~~~~~~~

cable2004 · 发表于 2015-2-11 11:50

看下精品，谢谢

434939575 · 发表于 2015-2-11 11:57

支持动态！好厉害。

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

[源码] 动态延升直线或圆弧

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子