请大师做一个这样的程序。

tangjunasd58 · 发表于 2013-1-23 00:15:17

框选方框可自动画成下面的效果。每种要能批量选择。价格合试，就定制

该贴已经同步到 tangjunasd58的微博

love1030312 · 发表于 2018-6-21 11:52:36

哈哈~~楼主用的还是周大师的那套软件哈他不是已经停止更新好久了么~ 现在系统都win10 他的软件支持不了win10呀我以前也用过~~后来他不更新放弃了

预知幸福 · 发表于 2022-11-8 16:05:25

tangjunasd58 发表于 2013-5-5 22:59
功能如图片

忘了在哪里 50元买了这个功能源码

现在应该好多人都有了

预知幸福 · 发表于 2022-12-2 21:32:37

阳阳阳发表于 2022-11-30 08:54
这个是好东西哦！哪位大侠提供下吧！

我有给钱发源码给你

xiabin68 · 发表于 2013-1-23 00:20:59

院长有这样的程序，，，你可以问问他，

sunny20102 · 发表于 2013-1-23 09:07:27

楼主搞门窗的? 典型的窗型图啊!

tangjunasd58 · 发表于 2013-1-23 22:20:05

我还有一个软件，是收费了的，跟他的有冲突，试用过。

【KAIXIN】 · 发表于 2013-1-24 08:20:40

发测试图出来，让大家练练手，不是很复杂

x_s_s_1 · 发表于 2013-1-24 09:55:19

本帖最后由 x_s_s_1 于 2013-1-24 10:00 编辑

组合论坛内代码，出处未标，均搜索自本站，请勿找麻烦，抛砖引玉

;;;给表根据X Y 给定的表达式进行排序-
;;;oflist :(0 > <)其中第一元素表示以X(0)优先还是以Y(1)优先
;;;第二位为X的排序关系第三位为Y的排序关系
;;;第四位为容差值。
;;;从上到下从左到右，容差为0
;;;实例：(NB_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 0 < <) 0)
;;;返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))
;;;从上到下从左到右，容差为1
;;;实例：(NetBee_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 1 < >) 1)
;;;返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))
(defun NB_px
(xyzlist oflist ddd / e1 e2 one oneof two twoof)
(setq one (car oflist))
(if (= one 0)
;;若以X优先
(setq one car ;_X
two CADR ;_Y
oneof (cadr oflist) ;_X
twoof (caddr oflist) ;_y
) ;_ 结束setq
;;若以Y优先
(setq one cadr ;_Y
two CAR ;_X
oneof (caddr oflist) ;_Y
twoof (cadr oflist) ;_X
) ;_ 结束setq
) ;_ 结束if
(vl-sort xyzlist
(function (lambda (e1 e2)
(cond
(
(> (abs (- (one e1) (one e2)))
ddd
) ;_ 结束>
(oneof (one e1)
(one e2)
) ;_ 结束oneof
)
(
T
(twoof
(two e1)
(two e2)
) ;_ 结束twoof
)
) ;_ 结束cond
) ;_ 结束lambda
) ;_ 结束function
) ;_ 结束vl-sort
) ;_ 结束defun
;;; [功能] 判断 X 是否是图元名
(defun MJ:enP (X)
(= (type X) 'ENAME)
)
;;; [功能] 将选择集转换为图元列表
;;; [参数] SS---选择集
;;; [返回] 表(图元列表长度图元列表)
(defun MJ:SS->LIST (SS)
(vl-remove-if-not
'MJ:enP
(mapcar
'cadr
(ssnamex SS)
)
)
)
(defun x_windows
(rows colu row1 colu1 pt / pt0 pt1 pt2 pt3 pt4 ww ptt ww)
(setq pt1 pt)
(setq ww (/ colu1 colu)) ;数据输入
(setq pt2 (polar pt1 0 colu1))
(setq pt3 (polar pt2 (* pi 0.5) row1))
(setq pt4 (polar pt1 (* pi 0.5) row1))
(command "line" pt1 pt2 pt3 pt4 "c") ;外框线
(setq ptt pt4
pt2 pt4
)
(repeat (1- rows)
(setq pt2 (polar pt2 (/ pi -2) row2))
(setq pt3 (polar pt2 0 colu1))
(command "line" pt2 pt3 "") ;横线
)
(setq pt2 pt1)
(if (> colu 1)
(repeat (1- colu)
(setq pt2 (polar pt2 0 ww))
(setq pt3 (polar pt2 (* pi 0.5) row1))
(command "line" pt2 pt3 "")
)
) ;竖线
(setq pt0 pt)
(repeat colu
(setq pt1 (mapcar '+ pt0 '(45 45 0)))
(setq pt2 (polar pt1 0 (- ww 90)))
(setq pt3 (polar pt1 (* pi 0.5) (- row1 (* row2 (1- rows)) 90)))
(setq pt4 (polar pt2 (* pi 0.5) (- row1 (* row2 (1- rows)) 90)))
(command "line" pt1 pt2 pt4 pt3 "c")
(setq pt0 (polar pt0 0 ww)) ;下框内框线
)
(repeat (1- rows)
(setq ptt (polar ptt (/ pi -2) row2))
(setq pt0 ptt)
(repeat colu
(setq pt1 (mapcar '+ pt0 '(45 45 0)))
(setq pt2 (polar pt1 0 (- ww 90)))
(setq pt3 (polar pt1 (* pi 0.5) (- row2 90)))
(setq pt4 (polar pt2 (* pi 0.5) (- row2 90)))
(command "line" pt1 pt2 pt4 pt3 "C")
(setq pt0 (polar pt0 0 ww)) ;上框内框线
)
)
)
(defun C:hcc (/ lay os rows colu row1 row2 colu1 ptlist x y ss)
(setvar "CMDECHO" 0)
(setq lay (getvar "clayer"))
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(command "color" "bylayer")
(command "layer" "m" "lmw" "c" "146" "lmw" "")
(setq rows (getint "\n窗a上下分格数(1不分格)/<或2>: ")) ;
(if (= rows nil)
(setq rows 2)
)
(setq colu (getint "\n窗扇数<3>: "))
(if (= colu nil)
(setq colu 3)
)
(if (> rows 1)
(progn
(setq row2 (getdist "\n窗上格高度<450>: "))
(if (= row2 nil)
(setq row2 450)
)
)
(setq row2 1)
)
(princ "选择窗外框线，必须PLINE")
(setq
ptlist
(mapcar
'(lambda (y)
(mapcar
'cdr
(vl-remove-if '(lambda (x) (/= 10 (car x))) (entget y))
)
)
(MJ:SS->LIST (setq ss (ssget '((0 . "*POLYLINE")))))
)
)
(SETQ
PTLIST (MAPCAR '(LAMBDA (X) (NB_px X (list 0 < <) 0)) PTLIST)
)
(SETQ PTLIST (MAPCAR '(LAMBDA (X)
(LIST (CAR X)
(DISTANCE (car x) (cadr x))
(DISTANCE (car x) (caddr x))
)
)
PTLIST
)
)
(mapcar '(lambda (x)
(x_windows rows colu (cadr x) (caddr x) (car x))
)
PTLIST
)
(command "ERASE" ss "")
(setvar "OSMODE" os)
(command "layer" "s" lay "")
(redraw)
(princ)
)

;;;给表根据X Y 给定的表达式进行排序- 
;;;oflist :(0 > <)其中第一元素表示以X(0)优先还是以Y(1)优先 
;;;第二位为X的排序关系第三位为Y的排序关系 
;;;第四位为容差值。 
;;;从上到下从左到右，容差为0 
;;;实例：(NB_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 0 < <) 0) 
;;;返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2)) 
;;;从上到下从左到右，容差为1 
;;;实例：(NetBee_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 1 < >) 1) 
;;;返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3)) 
(defun NB_px 
             (xyzlist oflist ddd / e1 e2 one oneof two twoof) 
  (setq one (car oflist)) 
  (if (= one 0) 
    ;;若以X优先 
    (setq one        car ;_X 
          two        CADR ;_Y 
          oneof        (cadr oflist) ;_X 
          twoof        (caddr oflist) ;_y 
    ) ;_ 结束setq 
    ;;若以Y优先 
    (setq one        cadr ;_Y 
          two        CAR ;_X 
          oneof        (caddr oflist) ;_Y 
          twoof        (cadr oflist) ;_X 
 
    ) ;_ 结束setq 
  ) ;_ 结束if 
  (vl-sort xyzlist 
           (function (lambda (e1 e2) 
                       (cond 
                         ( 
                          (> (abs (- (one e1) (one e2))) 
                             ddd 
                          ) ;_ 结束> 
                          (oneof (one e1) 
                                 (one e2) 
                          ) ;_ 结束oneof 
                         ) 
                         ( 
                          T 
                          (twoof 
                            (two e1) 
                            (two e2) 
                          ) ;_ 结束twoof 
                         ) 
                       ) ;_ 结束cond 
                     ) ;_ 结束lambda 
           ) ;_ 结束function 
  ) ;_ 结束vl-sort 
) ;_ 结束defun 
;;; [功能] 判断 X 是否是图元名 
(defun MJ:enP (X) 
  (= (type X) 'ENAME) 
) 
;;; [功能] 将选择集转换为图元列表 
;;; [参数] SS---选择集 
;;; [返回] 表(图元列表长度 图元列表) 
(defun MJ:SS->LIST (SS) 
  (vl-remove-if-not 
    'MJ:enP 
    (mapcar 
      'cadr 
      (ssnamex SS) 
    ) 
  ) 
) 
(defun x_windows 
       (rows colu row1 colu1 pt / pt0 pt1 pt2 pt3 pt4 ww ptt ww) 
  (setq pt1 pt) 
  (setq ww (/ colu1 colu))                ;数据输入 
  (setq pt2 (polar pt1 0 colu1)) 
  (setq pt3 (polar pt2 (* pi 0.5) row1)) 
  (setq pt4 (polar pt1 (* pi 0.5) row1)) 
  (command "line" pt1 pt2 pt3 pt4 "c")        ;外框线 
  (setq        ptt pt4 
        pt2 pt4 
  ) 
  (repeat (1- rows) 
    (setq pt2 (polar pt2 (/ pi -2) row2)) 
    (setq pt3 (polar pt2 0 colu1)) 
    (command "line" pt2 pt3 "")                ;横线 
  ) 
  (setq pt2 pt1) 
  (if (> colu 1) 
    (repeat (1- colu) 
      (setq pt2 (polar pt2 0 ww)) 
      (setq pt3 (polar pt2 (* pi 0.5) row1)) 
      (command "line" pt2 pt3 "") 
    ) 
  )                                        ;竖线 
  (setq pt0 pt) 
  (repeat colu 
    (setq pt1 (mapcar '+ pt0 '(45 45 0))) 
    (setq pt2 (polar pt1 0 (- ww 90))) 
    (setq pt3 (polar pt1 (* pi 0.5) (- row1 (* row2 (1- rows)) 90))) 
    (setq pt4 (polar pt2 (* pi 0.5) (- row1 (* row2 (1- rows)) 90))) 
    (command "line" pt1 pt2 pt4 pt3 "c") 
    (setq pt0 (polar pt0 0 ww))                ;下框内框线 
  ) 
  (repeat (1- rows) 
    (setq ptt (polar ptt (/ pi -2) row2)) 
    (setq pt0 ptt) 
    (repeat colu 
      (setq pt1 (mapcar '+ pt0 '(45 45 0))) 
      (setq pt2 (polar pt1 0 (- ww 90))) 
      (setq pt3 (polar pt1 (* pi 0.5) (- row2 90))) 
      (setq pt4 (polar pt2 (* pi 0.5) (- row2 90))) 
      (command "line" pt1 pt2 pt4 pt3 "C") 
      (setq pt0 (polar pt0 0 ww))        ;上框内框线 
    ) 
  ) 
) 
 
 
(defun C:hcc (/ lay os rows colu row1 row2 colu1 ptlist x y ss) 
  (setvar "CMDECHO" 0) 
  (setq lay (getvar "clayer")) 
  (setq os (getvar "OSMODE")) 
  (setvar "OSMODE" 0) 
  (command "color" "bylayer") 
  (command "layer" "m" "lmw" "c" "146" "lmw" "") 
  (setq rows (getint "\n窗a上下分格数(1不分格)/<或2>: ")) ; 
  (if (= rows nil) 
    (setq rows 2) 
  ) 
  (setq colu (getint "\n窗扇数<3>: ")) 
  (if (= colu nil) 
    (setq colu 3) 
  ) 
  (if (> rows 1) 
    (progn 
      (setq row2 (getdist "\n窗上格高度<450>: ")) 
      (if (= row2 nil) 
        (setq row2 450) 
      ) 
    ) 
    (setq row2 1) 
  ) 
  (princ "选择窗外框线，必须PLINE") 
  (setq 
    ptlist 
     (mapcar 
       '(lambda        (y) 
          (mapcar 
            'cdr 
            (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget y)) 
          ) 
        ) 
       (MJ:SS->LIST (setq ss (ssget '((0 . "*POLYLINE"))))) 
     ) 
  ) 
  (SETQ 
    PTLIST (MAPCAR '(LAMBDA (X) (NB_px X (list 0 < <) 0)) PTLIST) 
  ) 
  (SETQ        PTLIST (MAPCAR '(LAMBDA        (X) 
                          (LIST        (CAR X) 
                                (DISTANCE (car x) (cadr x)) 
                                (DISTANCE (car x) (caddr x)) 
                          ) 
                        ) 
                       PTLIST 
               ) 
  ) 
  (mapcar '(lambda (x) 
             (x_windows rows colu (cadr x) (caddr x) (car x)) 
           ) 
          PTLIST 
  ) 
  (command "ERASE" ss "") 
  (setvar "OSMODE" os) 
  (command "layer" "s" lay "") 
  (redraw) 
  (princ) 
)

tangjunasd58 · 发表于 2013-1-25 22:30:47

中间多了一根线。。。。

790027903 · 发表于 2013-4-28 18:01:30

做模型用的！

tangjunasd58 · 发表于 2013-5-5 22:53:14

是做模型用的。。。

tangjunasd58 · 发表于 2013-5-5 22:59:41

功能如图片

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

请大师做一个这样的程序。

本帖子中包含更多资源

相关帖子

本帖子中包含更多资源

本帖子中包含更多资源