求一个画上悬窗的小程序

52幕墙设计 · 发表于 2013-6-8 21:54:25

试了一下没问题啊

ucuc2003 · 发表于 2013-6-8 21:58:02

52幕墙设计发表于 2013-6-12 16:54
试了一下没问题啊

嗯是没有问题，但是没有框选功能

yoyoho · 发表于 2013-6-9 06:31:31

感谢Andyhon 分享程序
程序o.k.

xyp1964 · 发表于 2013-6-12 09:48:17

;; 上悬窗
(defun c:tt ()
(while (setq pt (getpoint "\n拾取内部点创建上悬窗<退出>: "))
(setq ee (bpoly pt))
(xyp-Offset ee 50 nil t t)
(setq s1 (entlast)
ptn (list (xyp-9pt s1 1) (xyp-9pt s1 8) (xyp-9pt s1 3))
s2 (xyp-Pline ptn Tnil)
)
)
(princ)
)

ucuc2003 · 发表于 2013-6-12 19:27:52

xyp1964 发表于 2013-6-16 04:48

院长你来了！！

感谢关注！！

chendili · 发表于 2013-8-13 15:22:44

我的为什么运行不了

ucuc2003 · 发表于 2013-8-13 17:04:12

chendili 发表于 2013-8-17 10:22
我的为什么运行不了

cad要把ET工具安装上

chendili · 发表于 2013-8-14 11:30:01

安装后成功运行

haoryh · 发表于 2014-8-27 11:55:11

ucuc2003 发表于 2013-6-3 20:15
(defun C:tt()
(vl-load-com)
(princ "\n拾取内部点创建上悬窗: ")

能不能实现只保留偏出来50的那条线？

ucuc2003 · 发表于 2014-8-31 21:23:00

haoryh 发表于 2014-8-31 06:55
能不能实现只保留偏出来50的那条线？

;;;拾取内部点创建上悬窗
(defun C:tt5 (/ tc col oldc pt ee pts pa pc)
(setvar "cmdecho" 0)
(vl-load-com)
(princ "\n拾取内部点创建上悬窗: ")
(while (setq pt (getpoint))
   (setq ee (bpoly pt))
   (setq ss (entlast))
   (vla-offset (vlax-ename->vla-object ee) -50)
   (setq ee (entlast)
         pts (acet-ent-geomextents ee)       ; ET function
         pa (car pts)
         pc (cadr pts)
   )
   (command "_.ERASE" ss "")
   (command "pline" "none" pa "none"
   (mapcar
      (function (lambda (a b) (/ (+ a b) 2)))
      pc
      (list (car pa) (cadr pc))
   )
   "none"
   (list (car pc) (cadr pa))
   ""
   )
);while
(princ)
)

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