
- ;;这程序并非为保密而写,但它的副产品是把line,circle,arc打碎
- ;;还原回原来的line,circle,arc有点难,但转为PLINE却很容易
- ;;所以也没有甚么用!!!
- ;;BY LUCAS(龙龙仔)
- ;|
- ;;该程序是用来将线、圆、弧打上缺口,缺口大小与个数由用户输入,
- ;;这个程序是用在激光切割图形方面的,这个缺口,
- ;;专有名词叫"桥位",就是激光按照图形切割时,
- ;;桥位的地方就不要切,目的是防止图形中闭合部分掉下去,
- |;
- (defun C:BK (/ HOLDECHO HOLDOSMODE HOLDCL QBLL AA
- QI QCCC CBB AAB BB ST QED AD
- DD AJ XAA AED ANG SPT ANS ANE
- ANG PT PT1 ACCC ARC_1 ARC_L
- )
- (setq HOLDECHO (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (command "_.undo" "group")
- (setq HOLDOSMODE (getvar "osmode"))
- (setq HOLDCL (getvar "clayer"))
- (setvar "osmode" 0)
- (setq QBL (getdist (strcat "\n 请输入缺口尺寸:<6>: ")))
- (if (= QBL NIL)
- (setq QBL 6.0)
- )
- (setq AA (ssget '((0 . "line,circle,arc"))))
- (setq QI 0
- QCCC 1
- QCC NIL
- CBB 1
- CB NIL
- ACCC 1
- ACC NIL
- )
- (if (/= NIL AA)
- (repeat (sslength AA)
- (setq AAB (ssname AA QI))
- (redraw AAB 3)
- (setq BB (cdr (assoc 0 (entget AAB))))
- (setvar "clayer" (cdr (assoc 8 (entget AAB))))
- (cond
- ((= BB "LINE")
- (setq ST (cdr (assoc 11 (entget AAB))))
- (setq QED (cdr (assoc 10 (entget AAB))))
- (setq AD (distance ST QED)
- DD (angle ST QED)
- )
- (if (< QBL AD)
- (progn
- (while (or (= QCC NIL) (> (* QCC QBL) AD))
- (setq QCC
- (getint
- (strcat "\n 输入直线缺口个数 :<" (rtos QCCC) ">: ")
- )
- )
- (if (= QCC NIL)
- (setq QCC QCCC)
- (setq QCCC QCC)
- )
- )
- (setq AJ (/ (- AD (* QBL QCC)) (+ QCC 1)))
- (setq XAA (polar ST DD (+ AJ QBL)))
- (entdel AAB)
- (command "_.line" ST (polar ST DD AJ) "")
- (repeat QCC (command "_.copy" (entlast) "" ST XAA))
- )
- )
- )
- ((= BB "CIRCLE")
- (setq ST (cdr (assoc 10 (entget AAB))))
- (setq AED (cdr (assoc 40 (entget AAB))))
- (if (< QBL (* pi 2 AED))
- (progn
- (while (or (= CB NIL) (> (* CB QBL) (* pi 2 AED)))
- (setq
- CB
- (getint
- (strcat "\n 输入圆上缺口个数 :<" (rtos CBB) ">: ")
- )
- )
- (if (= CB NIL)
- (setq CB CBB)
- (setq CBB CB)
- )
- )
- (setq AJ (/ (- (* pi 2 AED) (* QBL CB)) CB))
- (setq ANG (/ AJ AED 2.0))
- (if
- (>= (distance (polar ST (- ANG) AED) (polar ST ANG AED))
- 0.0001
- )
- (progn
- (entdel AAB)
- (command "_.arc"
- (polar ST (- ANG) AED)
- (polar ST 0 AED)
- (polar ST ANG AED)
- )
- (if (> CB 1)
- (command "_.array" (entlast) "" "p" ST CB "" "")
- )
- )
- )
- )
- )
- )
- ((= BB "ARC")
- (setq ST (cdr (assoc 10 (entget AAB))))
- (setq AED (cdr (assoc 40 (entget AAB))))
- (setq SPT (polar ST (cdr (assoc 50 (entget AAB))) AED))
- (setq ANS (cdr (assoc 50 (entget AAB))))
- (setq ANE (cdr (assoc 51 (entget AAB))))
- (if (> ANE ANS)
- (setq ANG (- ANE ANS))
- (setq ANG (+ ANE (- (* 2 pi) ANS)))
- )
- (setq ARC_L (* AED ANG))
- (if (< QBL ARC_L)
- (progn
- (while (or (= ACC NIL) (> (* ACC QBL) ARC_L))
- (setq ACC
- (getint
- (strcat "\n 输入弧线缺口个数 :<" (rtos ACCC) ">: ")
- )
- )
- (if (= ACC NIL)
- (setq ACC ACCC)
- (setq ACCC ACC)
- )
- )
- (setq ARC_1 (/ (- ARC_L (* QBL ACC)) (1+ ACC) AED))
- (entdel AAB)
- (command "_.arc" "c" ST SPT "A" (/ (* ARC_1 180) pi))
- (command "_.ARRAY"
- (entlast)
- ""
- "P"
- ST
- (1+ ACC)
- (/ (* (- (/ ARC_L AED) ARC_1) 180) pi)
- ""
- )
- )
- )
- )
- )
- (setq QI (1+ QI))
- )
- )
- (setvar "clayer" HOLDCL)
- (setvar "osmode" HOLDOSMODE)
- (command "_.undo" "end")
- (setvar "cmdecho" HOLDECHO)
- (princ)
- )
|