折弯快速标注

seamopan

zhangcan0515 发表于 2020-12-12 10:30
你看看这样的。哈河

大佬，能给程序发出来学习下吗？付费也行

zhangcan0515

seamopan 发表于 2022-4-28 21:46
大佬，能给程序发出来学习下吗？付费也行

测试了，还不太符合钣金的使用。问题在解决中

天凉好个秋

zhangcan0515 发表于 2022-4-30 20:27
测试了，还不太符合钣金的使用。问题在解决中

同楼主

JRYG_CAD

折弯快速标注

JRYG_CAD

折弯快速标注

zero423

下面是我编的程序，希望有人能优化一下！
(defun c:ww (/ a dist dist1 ent1 ent2 name1 name2 pt1 pt2 pt3 pt4 ss1 ss2 ss3 ss4)
((setvar "cmdecho" 0));;;前设置
(vl-cmdf ".UCS" "w")
(vl-cmdf ".UNDO" "G")
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun midpoint (p1 p2) (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2));;;取中点
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun LM:SSBoundingBox ( ssi / i l1 l2 ll ur );;;更改于LEEMAC的程序最大包围盒
(setq sx1 '() sx2 '())
(repeat (setq i (sslength ssi))      
(if(or(= (cdr(assoc 0 (entget(ssname ssi (1- i))))) "DIMENSION")(= (cdr(assoc 0 (entget(ssname ssi (1- i))))) "LEADER")(= (cdr(assoc 0 (entget(ssname ssi (1- i))))) "TEXT")(= (cdr(assoc 0 (entget(ssname ssi (1- i))))) "MTEXT"))
()(progn (vla-getboundingbox (vlax-ename->vla-object (ssname ssi (1- i))) 'll 'ur) (setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2))))
(setq i (1- i)))
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun same(l1 / l2);;;查找表中重复元素
  (while l1(if(member(car l1)(cdr l1))(setq l2(append l2(list(car l1)))))(setq l1(vl-remove (car l1)l1)))
  l2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun sametimes(l1);;;;表中重复元素及其重复次数
  (mapcar'(lambda(x)(cons x(-(length l1)(length(vl-remove x l1)))))
(same l1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ptlist_sortdx (ptlistmm xa xy / nx1)
(SETQ smm(length ptlistmm) snn 0 x1min nil x1max nil y1min nil y1max nil)
(repeat smm
(setq nx1(nth snn ptlistmm))
(cond((= xy "x")(if(equal xa (car nx1) 0.025)(progn(if(= y1min nil)(setq y1min(cadr nx1))(setq y1min(min y1min (cadr nx1))))
                                    (if(= y1max nil)(setq y1max(cadr nx1))(setq y1max(max y1max (cadr nx1)))))))
     ((= xy "y")(if(equal xa (cadr nx1) 0.025)(progn(if(= x1min nil)(setq x1min(car nx1))(setq x1min(min x1min (car nx1))))
                                    (if(= x1max nil)(setq x1max(car nx1))(setq x1max(max x1max (car nx1))))))))
(setq smm(1- smm) snn (1+ snn))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zxl201004010097k (ssmm / )
;;;  (setq ssmm ss)
(setq ssmmn(sslength ssmm))(setq mm 0)(setq ptlistmm '())
(repeat ssmmn
(cond((= (cdr(assoc 0 (entget(ssname ssmm mm))))"LINE")(progn(setq ptlistmm(append ptlistmm (list(cdr(assoc 10 (entget(ssname ssmm mm)))))))(setq ptlistmm(append ptlistmm (list(cdr(assoc 11 (entget(ssname ssmm mm)))))))))
     ((= (cdr(assoc 0 (entget(ssname ssmm mm))))"ARC")(progn
(setq an1(cdr(assoc 50 (entget(ssname ssmm mm)))))(setq an2(cdr(assoc 51 (entget(ssname ssmm mm)))))
(if (< an2 an1)(setq an2(+ an2 (* PI 2))))
(cond((and(< an1 (/ (* pi 2.) 1.))(> an2 (/ (* pi 2.) 1.)))(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm)))) 0 (cdr(assoc 40 (entget(ssname ssmm mm)))))))))
((or(and(< an1 (/ (* pi 1.) 2.))(> an2 (/ (* pi 1.) 2.)))(and(< an1 (/ (* pi 5.) 2.))(> an2 (/ (* pi 5.) 2.))))(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm)))) (/ (* pi 1.) 2.) (cdr(assoc 40 (entget(ssname ssmm mm)))))))))
((or(and(< an1 (/ (* pi 2.) 2.))(> an2 (/ (* pi 2.) 2.)))(and(< an1 (/ (* pi 6.) 2.))(> an2 (/ (* pi 6.) 2.))))(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm)))) (/ (* pi 2.) 2.) (cdr(assoc 40 (entget(ssname ssmm mm)))))))))
((or(and(< an1 (/ (* pi 3.) 2.))(> an2 (/ (* pi 3.) 2.)))(and(< an1 (/ (* pi 7.) 2.))(> an2 (/ (* pi 7.) 2.))))(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm)))) (/ (* pi 2.) 2.) (cdr(assoc 40 (entget(ssname ssmm mm))))))))))  
(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm))))(cdr(assoc 50 (entget(ssname ssmm mm))))(cdr(assoc 40 (entget(ssname ssmm mm))))))))
(setq ptlistmm(append ptlistmm (list(polar (cdr(assoc 10 (entget(ssname ssmm mm))))(cdr(assoc 51 (entget(ssname ssmm mm))))(cdr(assoc 40 (entget(ssname ssmm mm)))))))))))
(setq ssmmn (1- ssmmn) mm(1+ mm)))
ptlistmm)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\n快速直角折弯标注:")(setvar "osmode" 16383)
(setq ss(ssget'((0 . "LINE"))))
(if ss(progn(setq aa(LM:SSBoundingBox ss))(setq mpt(midpoint(car aa)(cadr aa)))
(setq sn(sslength ss) n 0 distlist '() dist1 nil distmax nil ssmax (ssadd))
(repeat sn
(if(AND(<= (distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n))))) 6)
  (>= (distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n))))) 0.4))
(setq distlist(append distlist (list(distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n)))))))))
(if (null distmax)(progn(setq distmax (distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n))))))
(setq ssmax(ssadd (ssname ss n) ssmax ))))
(if (> (distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n))))) distmax)
(progn(setq distmax (distance(cdr(assoc 10 (entget(ssname ss n))))(cdr(assoc 11 (entget(ssname ss n))))))
(setq ssmax(ssadd (ssname ss n) ssmax))))
(setq sn(1- sn)n(1+ n)))
(if distlist(progn
(setq distlist(vl-sort distlist '<))
(setq distlist(sametimes distlist))
(setq distlist(vl-sort distlist (function (lambda (e1 e2) (<= (cdr e1) (cdr e2))))))
(setq sn1(length distlist) n 0 chanshu001x 0)(setvar "osmode" 0)
(repeat sn1  
(if(or (SETQ SSSS(ssget "C" (polar (midpoint(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(+(angle(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(/ pi 2.))(car(nth n distlist)))(polar (midpoint(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(+(angle(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(/ pi 2.))(car(nth n distlist)))))
       (SETQ SSSS(ssget "C" (polar (midpoint(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(-(angle(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(/ pi 2.))(car(nth n distlist)))(polar (midpoint(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(-(angle(cdr(assoc 10 (entget(ssname ssmax(- (sslength ssmax) 1)))))(cdr(assoc 11 (entget(ssname ssmax(- (sslength ssmax) 1))))))(/ pi 2.))(car(nth n distlist))))))
(setq chanshu001x(car(nth n distlist))))
(setq sn1(1- sn1)n(1+ n))))(progn
(setq mmt (vl-registry-read reg_path "mmt"))
(if(= mmt nil)(progn(setq mmt 0.0)(vl-registry-write reg_path "mmt"(rtos mmt 2 1)))(setq mmt(read mmt)))
(setq chanshu001x (getdist (strcat "\n 输入偏移距离:<" (rtos mmt 2 1) ">")))
(if (null chanshu001x)(setq chanshu001x mmt)(progn(setq mmt chanshu001x)(vl-registry-write reg_path "mmt"(rtos mmt 2 1))))))
(while (> (sslength ss) 0)
(setq ssn1 (ssadd))
(setq name1(ssname ss 0))
(setq ent1 (entget name1))
(setq PT1 (cdr (assoc 10 ent1)))
(setq PT2 (cdr (assoc 11 ent1)))
(setq ns1(sslength ss) n1 0)
(repeat ns1
(setq angx1 nil)(setq ss1x (ssadd))(setq ss2x (ssadd))
(setq name2(ssname ss n1))
(setq ent2 (entget name2))
(setq PT3 (cdr (assoc 10 ent2)))
(setq PT4 (cdr (assoc 11 ent2)))
(if(and(equal(distance (midpoint pt1 pt2) (vlax-curve-getclosestpointto name2 (midpoint pt1 pt2) t))(distance (midpoint pt3 pt4) (vlax-curve-getclosestpointto name1 (midpoint pt3 pt4) t)) 0.0001)
(equal chanshu001x (distance (midpoint pt1 pt2) (vlax-curve-getclosestpointto name2 (midpoint pt1 pt2) nil))0.0001)
(>= (* chanshu001x (sqrt 5))(distance (midpoint pt1 pt2) (midpoint pt3 pt4))))
(progn(setq ssn1 (ssadd name1 ssn1))(setq ssn1 (ssadd name2 ssn1))(setq angx(angle mpt (vlax-curve-getclosestpointto name1 mpt t)))
(setq ss1(ssget "c" (polar (list (max(car pt1)(car pt2)) (max(cadr pt1)(cadr pt2)) 0)(/ (* 1. pi) 4.) 0.1)(polar (polar (list (min(car pt1)(car pt2)) (min(cadr pt1)(cadr pt2)) 0)(/ (* 1. pi) 4.) 0.1) (/ (* 5. pi) 4.) 0.1) '((0 . "LINE,ARC"))))
(if ss1(progn
(while(> (sslength ss1) 0)
(COND((= (cdr(assoc 0 (entget(ssname ss1 0)))) "LINE")(IF(or(EQUAL angx (angle (cdr(assoc 10 (entget(ssname ss1 0)))) (cdr(assoc 11 (entget(ssname ss1 0))))) 0.05)(EQUAL angx (angle (cdr(assoc 11 (entget(ssname ss1 0)))) (cdr(assoc 10(entget(ssname ss1 0))))) 0.05))(setq ssn1(ssadd (ssname ss1 0) ssn1))))
((= (cdr(assoc 0 (entget(ssname ss1 0)))) "ARC")(progn(setq ss1x(ssget "c" (polar (cdr(assoc 10(entget(ssname ss1 0)))) (/ (* 1. pi) 4.) (+ (cdr(assoc 40(entget(ssname ss1 0)))) 0.1))(polar (cdr(assoc 10(entget(ssname ss1 0)))) (/ (* 5. pi) 4.) (+ (cdr(assoc 40(entget(ssname ss1 0)))) 0.1)) '((0 . "LINE,ARC"))))
(while(> (sslength ss1x) 0)(COND((= (cdr(assoc 0 (entget(ssname ss1x 0)))) "LINE")(IF (or(EQUAL angx (angle (cdr(assoc 10 (entget(ssname ss1x 0)))) (cdr(assoc 11 (entget(ssname ss1x 0))))) 0.05)(EQUAL angx (angle (cdr(assoc 11 (entget(ssname ss1x 0)))) (cdr(assoc 10(entget(ssname ss1x 0))))) 0.05))(setq ssn1(ssadd (ssname ss1x 0) ssn1))))
((= (cdr(assoc 0 (entget(ssname ss1x 0)))) "ARC")(setq ssn1(ssadd (ssname ss1x 0) ssn1))))
(setq ss1x(ssdel (ssname ss1x 0) ss1x))))))
(setq ss1(ssdel (ssname ss1 0) ss1)))))
(setq ss2(ssget "c" (polar (list (max(car pt3)(car pt4)) (max(cadr pt3)(cadr pt4)) 0)(/ (* 1. pi) 4.) 0.1)(polar (polar (list (min(car pt3)(car pt4)) (min(cadr pt3)(cadr pt4)) 0)(/ (* 1. pi) 4.) 0.1) (/ (* 5. pi) 4.) 0.1) '((0 . "LINE,ARC"))))
(if ss2(progn
(while(> (sslength ss2) 0)
(COND((= (cdr(assoc 0 (entget(ssname ss2 0)))) "LINE")(IF(or(EQUAL angx (angle (cdr(assoc 10 (entget(ssname ss2 0)))) (cdr(assoc 11 (entget(ssname ss2 0))))) 0.05)(EQUAL angx (angle (cdr(assoc 11 (entget(ssname ss2 0)))) (cdr(assoc 10(entget(ssname ss2 0))))) 0.05))(setq ssn1(ssadd (ssname ss2 0) ssn1))))
((= (cdr(assoc 0 (entget(ssname ss2 0)))) "ARC")(progn(setq ss2x(ssget "c" (polar (cdr(assoc 10(entget(ssname ss2 0)))) (/ (* 1. pi) 4.) (+ (cdr(assoc 40(entget(ssname ss2 0)))) 0.1))(polar (cdr(assoc 10(entget(ssname ss2 0)))) (/ (* 5. pi) 4.) (+ (cdr(assoc 40(entget(ssname ss2 0)))) 0.1)) '((0 . "LINE,ARC"))))
(while(> (sslength ss2x) 0)(COND((= (cdr(assoc 0 (entget(ssname ss2x 0)))) "LINE")(IF (or(EQUAL angx (angle (cdr(assoc 10 (entget(ssname ss2x 0)))) (cdr(assoc 11 (entget(ssname ss2x 0))))) 0.05)(EQUAL angx (angle (cdr(assoc 11 (entget(ssname ss2x 0)))) (cdr(assoc 10(entget(ssname ss2x 0))))) 0.05))(setq ssn1(ssadd (ssname ss2x 0) ssn1))))
((= (cdr(assoc 0 (entget(ssname ss2x 0)))) "ARC")(setq ssn1(ssadd (ssname ss2x 0) ssn1))))
(setq ss2x(ssdel (ssname ss2x 0) ss2x))))))
(setq ss2(ssdel (ssname ss2 0) ss2)))))
(setq bb (LM:SSBoundingBox ssn1))
(ptlist_sortdx (zxl201004010097k ssn1) (caar bb) "x")
(if y1min (setq pt1xminy(list (caar bb) y1min))(setq pt1xminy(list (caar  bb) (cadar  bb))))
(if y1max (setq pt1xmaxy(list (caar bb) y1max))(setq pt1xmaxy(list (caar  bb) (cadadr bb))))
(ptlist_sortdx (zxl201004010097k ssn1) (caadr bb) "x")
(if y1min (setq pt2xminy(list (caadr bb) y1min))(setq pt2xminy(list (caadr bb) (cadar  bb))))
(if y1max(setq pt2xmaxy(list (caadr bb) y1max))(setq pt2xmaxy(list  (caadr bb) (cadadr bb))))
(ptlist_sortdx (zxl201004010097k ssn1) (cadar  bb) "y")
(if x1min(setq pt1yminx(list x1min(cadar bb)))(setq pt1yminx(list (caar  bb) (cadar  bb))))
(if x1max(setq pt1ymaxx(list x1max(cadar bb)))(setq pt1ymaxx(list (caadr bb) (cadar  bb))))
(ptlist_sortdx (zxl201004010097k ssn1) (cadadr bb) "y")
(if x1min(setq pt2yminx(list x1min (cadadr bb)))(setq pt2yminx(list (caar  bb) (cadadr bb))))
(if x1max(setq pt2ymaxx(list x1max (cadadr bb)))(setq pt2ymaxx(list (caadr bb) (cadadr bb))))
               ;;;加载标注图层
(setvar "osmode" 0)
(cond ((equal angx (/ pi 2.) 0.1)(vl-cmdf ".DIMLINEAR" pt2xmaxy pt1xmaxy  (list (/(+ (caar  bb) (caar  bb)) 2.) (+ (cadadr  bb) (* 5 (getvar "dimscale"))))))
      ((equal angx pi 0.1)(vl-cmdf ".DIMLINEAR" pt2yminx pt1yminx  (list (- (caar  bb) (* 5 (getvar "dimscale"))) (/(+ (cadar  bb) (cadadr bb)) 2.))))
      ((equal angx (/ (* 3. pi) 2.) 0.1)(vl-cmdf ".DIMLINEAR"  pt2xminy pt1xminy(list (/(+ (caar  bb) (caar  bb)) 2.) (- (cadar  bb) (* 5 (getvar "dimscale"))))))
      ((or (equal angx 0 0.1)(equal angx (* pi 2) 0.1))(vl-cmdf ".DIMLINEAR" pt2ymaxx pt1ymaxx  (list (+ (caadr bb) (* 5 (getvar "dimscale"))) (/(+ (cadar  bb) (cadadr bb)) 2.))))
      (t (prompt"\n未有任何标注")))
(setq ss (ssdel name2 ss))(setq ns1(sslength ss) n1 (1- n1))))
(setq ns1(1- ns1) n1 (1+ n1)))(setq ss(ssdel name1 ss))))(prompt"\n未有任何选择"))
(vl-cmdf ".UNDO" "E")
(prin1);;;回复设置
)

yoyoho

zero423 发表于 2022-11-11 12:47
下面是我编的程序，希望有人能优化一下！
(defun c:ww (/ a dist dist1 ent1 ent2 name1 name2 pt1 pt2 pt ...

指令: WW
渣昫 : 损坏的函数: 0

xyp1964

cheefeel

哇哦~~~ 看到了那么多大佬优秀的演示动画。还是没看到成熟插件源码，期待中。。。。虽然不是做钣金的，也很少参与钣金相关的事情，但偏偏最近遇到了为一批型材开模的需要。

Grgogo

xyp1964 发表于 2022-11-11 19:16

版主，后续呢？？这是成品插件吗