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

试了一下没问题啊

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

52幕墙设计 发表于 2013-6-12 16:54 static/image/common/back.gif
试了一下没问题啊

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

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 static/image/common/back.gif


院长你来了！！感谢关注！！

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

我的为什么运行不了

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

chendili 发表于 2013-8-17 10:22 static/image/common/back.gif
我的为什么运行不了

cad要把ET工具安装上

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

安装后成功运行

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

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


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

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

haoryh 发表于 2014-8-31 06:55 static/image/common/back.gif
能不能实现只保留偏出来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)
)
页: 1 [2] 3
查看完整版本: 求一个画上悬窗的小程序