明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 403|回复: 2

[提问] (求助)麻烦各位大神出手,帮小弟我改一下以下源码,谢谢啦

[复制链接]
发表于 2020-11-23 15:30 | 显示全部楼层 |阅读模式
5明经币
以下源码不清楚是哪位大神的杰作,之前是用做矩形的生成料位及立面,后来用在不规则的平面上有些可以用,有些用了生成不了,有些用了会出现有一两块料对不上平面,麻烦大神帮忙解决改改谢谢喽:
以下是源码及需要改成的后的效果:
1.料位生成从左下角开始往右逆时针生成,料位是X轴包Y轴
2.生成后的立面为layer1图层
3.可以实现不规则平面的生成(斜边,圆弧),也能展开
4.提高料位的准确性,目前的插件是用在矩形上面的,不规则的平面容易出问题

;建筑料位
(defun c:sx(/ ab a b en en1 en2 en3 en4 d1e1 neare1 neard1 ang1 ang2 i lw dw d1 d1+ e1+ xlen ylen len lennew n n1 n2 po pt1 pt2 h w plist wp p1 p2 p3 p4 fx obj)
(if(setq en(entsel"\n选择外框:"))
  (progn
    (setq en1(car en) dw(osnap (cadr en) "nea") ssline nil)
    (setq lw(getreal"\n输入料位:") fx(getpoint"\n偏移方向:"))
    (command "offset" lw en1 fx "")
    (setq en2(entlast))(if(> (getarea en2)(getarea en1))(setq en3 en2)(setq en3 en1))
    (setq  en4(vlax-ename->vla-object en3))
    (setq enlist1(pl-d en1) enlist2(pl-d en2))
    (setq i 0)
   (repeat (- (length enlist2) 1)
      (setq d1(nth i enlist2) e1(nth i enlist1) ang1(angle d1 e1) ang2(angle  e1 d1))
      (cond ((or(and(> ang1 0)(<= ang1 (* 0.5 pi)))(and(> ang1  pi)(<= ang1 (* 1.5 pi))));;第一第三象限+45
        (setq d1+(polar d1 (+ ang1 (/ pi 4)) lw))
      )
     ( (or(and(> ang1 (* 0.5 pi))(<= ang1  pi))(and(> ang1 (* 1.5 pi))(<= ang1 (* 2 pi))));;第二第四象限-45
           (setq d1+(polar d1 (- ang1 (/ pi 4)) lw))
      )
     )
      (cond ((or(and(> ang2 0)(<= ang2 (* 0.5 pi)))(and(> ang2  pi)(<= ang2 (* 1.5 pi))));;第一第三象限+45
        (setq e1+(polar e1 (+ ang2 (/ pi 4)) lw))
      )
     ( (or(and(> ang2 (* 0.5 pi))(<= ang2  pi))(and(> ang2 (* 1.5 pi))(<= ang2 (* 2 pi))));;第二第四象限-45
           (setq e1+(polar e1 (- ang2 (/ pi 4)) lw))
      )
     )
      (if(equal d1+ (near  en1 d1+) 0.1)
               (setq nearpt d1+ stpt d1)
        (setq nearpt e1+ stpt e1)
)
      (setq d1e1(distance d1 e1))
         (if
       (equal (N^ d1e1)(* 2 (N^ lw)) 0.01)
         (makeline nearpt stpt)
         (makeline d1 e1)
         )
     (setq i(1+ i))
      (setq ssline(cons (entlast) ssline))
    )
     (setq ssline(cons (car ssline) (reverse ssline)))
   (setq n 0 plist nil)
   (setq po(getpoint"\n指定放置点:") h(getdist"\n指定高度:") w(getdist"\n指定间隔:"))
   (command "undo" "be")
   (repeat (1- (length ssline))
     (setq n1(nth n ssline) n2(nth  (1+ n) ssline))
     (setq p1(dxf 10 n1) p2(dxf 11 n1) p3(dxf 10 n2) p4(dxf 11 n2))
     (setq plist(append(list p1)(list p2)(list p3)(list p4) plist))
     (setq ab(minmax plist) a(car ab) b(cadr ab))
     (setq xlen (abs (- (car B) (car A))))
     (setq ylen (abs (- (cadr B) (cadr A))))
     (if (or (member (car p1) p3)(member (cadr p1) p4))
       (progn
         (cond ((> xlen ylen)(setq len xlen pt1(list(+ (car a) (/ len 2))(cadr a))))
               ((< xlen ylen)(setq len ylen pt1(list (car a) (+ (cadr a) (/ len 2)))))
          )
  )
       (progn
  (foreach n plist
    (if(equal n (near en3 n))(setq wp(cons  n wp)))
    )
  (setq len(distance (car wp)(cadr wp)) pt1(mid(car wp)(cadr wp)) pt10(polar pt1 (angtof "90") 5))
     (if (not(equal pt1 (near en3 pt10))) ;判断是否有弧度
       (progn
       (setq len(distpt en4 (car wp)(cadr wp)) pt1(near en3 pt10))
       (if (> len (* 2 (distance (car wp)(cadr wp))))
  (setq len(- (getlen en4) len))
  )
     )
           )
  )
       )
    (command "rectang" "NON" po  "NON" (mapcar '+ po (list len h)))
    (setq pt2(list(+ (car po) (/ len 2)) (cadr po)) pt2(polar pt2 (angtof "-90") 5))
    (setq po(list(+(car po) len w)(cadr po)))
    (entmake (list '(0 . "TEXT") (cons 1(itoa (1+ n))) (cons 10 pt1) (cons 40 5)(cons 50 0)))
    (entmake (list '(0 . "TEXT") (cons 1(itoa (1+ n))) (cons 10 pt2) (cons 40 5)(cons 50 0)))
    ;(setq lennew(cons len lennew))
   (setq n(1+ n) plist nil)
  )
   (command "undo" "e")
  )
)
(princ)
)
  
;;;;;;;;求平方
(defun N^(x)(* x x))
  
;;;;;;;;;;
;;;;;求点集中最小和最大点
(defun minmax(plist)
(list (apply 'mapcar (cons 'min plist))
      (apply 'mapcar (cons 'max plist)))
)
;;;两点画线
(defun makeline(p1 p2)
(entmake (list '(0 . "line") '(62 . 1) (cons 10 p1) (cons 11 p2)))
)
;;;求点到曲线最近点
(defun near (e pt)
   (vlax-curve-getClosestPointTo e pt)
)
;;;;;;;;;
;求pline,lwpline端点
(defun pl-d  (e / i v lst)
   (setq i -1)
   (while
  (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
      (setq lst (cons v lst))
   )(reverse lst)
)

;;;;;;;;取组码值
(defun dxf(n endata)
   (if(= (type endata) 'ENAME)(cdr(assoc n(entget endata)))
     (cdr(assoc n endata))
     )
   )
;;;求中点
(defun mid (x y)
  (mapcar '(lambda (a b) (* (+ a b) 0.5)) x y)
)
;;;
;;;;计算面积
(defun getarea (en)
  (setq obj (vlax-ename->vla-object en))
   (vlax-curve-getArea obj)
)
;;;;
;;;;;求周长
(defun getlen(obj)
   (vlax-curve-getdistatparam obj(vlax-curve-getendparam obj))
)
;;;
;;;曲线上任意两点间距离
(defun distpt(obj p1 p2)
(abs (- (vlax-curve-getDistAtPoint obj p2)
     ;返回曲线从开始点到指定点的曲线段的长度
     (vlax-curve-getDistAtPoint obj p1)
  )
    )
   
)
;;;判断点是否在线上
(defun ptonline (pt p1 p2)
  (equal (+ (distance pt p1) (distance pt p2))
  (distance p1 p2)
  )
)

附件: 您需要 登录 才可以下载或查看,没有账号?注册
发表于 2020-12-3 21:02 | 显示全部楼层
帮忙顶下
回复

使用道具 举报

发表于 2020-12-4 01:13 | 显示全部楼层
粗粗看了下,没有osmode变量的设置,试试使用时先关闭对象捕捉,然后全屏显示。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-27 18:31 , Processed in 0.240022 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表