请高手用AutoLISP编写小程序
求高手编一个扫孔坐标的程序(要选孔的时候可以根据大小孔进行筛选不用一个一个选的)最后用ABCD等字母分别表示就像有一个CD程序差不多的那种!...
求高手编一个扫孔坐标的程序 (要选孔的时候可以根据大小孔进行筛选不用一个一个选的)最后用ABCD等字母分别表示 就像有一个CD程序差不多的那种!
展开
3个回答
展开全部
(一)
(defun c:tuxing1 ()
(setq Rd (getdist "\n R=:"))
(setq Rx (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq p1 (list(car p0) (+ (+ (cadr p0) Rd) 5)))
(setq p2 (list(- (- (car p0) Rd) 5) (cadr p0)))
(setq p3 (list(car p0) (- (- (cadr p0) Rd) 5)))
(setq p4 (list(+ (+ (car p0) Rd) 5) (cadr p0)))
(Command "line" p1 p3"")
(Command "line" p2 p4"")
(Command "circle" p0 Rd)
(Command "circle" p0 RX)
)
(二)
(defun c:tuxing2 ()
(setq Rd (getdist "\n R=:"))
(setq Rx (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq a1 (list(+ (car p0) (* (cos (/ pi 4)) Rx)) (+ (cadr p0) (* (cos (/ pi 4)) Rx))))
(setq a2 (list(- (car p0) (* (cos (/ pi 4)) Rx)) (cadr a1)))
(setq a3 (list(car a2) (- (cadr p0) (* (cos (/ pi 4)) Rx))))
(setq a4 (list(car a1) (cadr a3)))
(setq b1 (list(+ (car p0) (* (cos (/ pi 4)) Rd)) (+ (cadr p0) (* (cos (/ pi 4)) Rd))))
(setq b2 (list(- (car p0) (* (cos (/ pi 4)) Rd)) (cadr b1)))
(setq b3 (list(car b2) (- (cadr p0) (* (cos (/ pi 4)) Rd))))
(setq b4 (list(car b1) (cadr b3)))
(Command "line" a1 a2 a3 a4 a1"")
(Command "line" b1 b2 b3 b4 b1"")
(Command "circle" p0 Rd)
(Command "circle" p0 RX)
)
(三)
(defun c:tuxing3 ()
(setq r (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq p1 (list(- (car p0) (* r 2)) (cadr p0)))
setq p2 (list(+ (car p0) (* r 2)) (cadr p0)))
((Command "circle" p0 r)
(Command "circle" p1 r)
(Command "circle" p2 r)
)
(四)
(defun c:tuxing4 ()
(setq r (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq a1 (list(+ (car p0) (* (cos (/ pi 4)) r)) (+ (cadr p0) (* (cos (/ pi 4)) r))))
(setq a2 (list(- (car p0) (* (cos (/ pi 4)) r)) (cadr a1)))
(setq a3 (list(car a2) (- (cadr p0) (* (cos (/ pi 4)) r))))
(setq a4 (list(car a1) (cadr a3)))
(Command "line" a1 a2 a3 a4 a1"")
(Command "circle" p0 r)
)
可以了,你试试吧!
(defun c:tuxing1 ()
(setq Rd (getdist "\n R=:"))
(setq Rx (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq p1 (list(car p0) (+ (+ (cadr p0) Rd) 5)))
(setq p2 (list(- (- (car p0) Rd) 5) (cadr p0)))
(setq p3 (list(car p0) (- (- (cadr p0) Rd) 5)))
(setq p4 (list(+ (+ (car p0) Rd) 5) (cadr p0)))
(Command "line" p1 p3"")
(Command "line" p2 p4"")
(Command "circle" p0 Rd)
(Command "circle" p0 RX)
)
(二)
(defun c:tuxing2 ()
(setq Rd (getdist "\n R=:"))
(setq Rx (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq a1 (list(+ (car p0) (* (cos (/ pi 4)) Rx)) (+ (cadr p0) (* (cos (/ pi 4)) Rx))))
(setq a2 (list(- (car p0) (* (cos (/ pi 4)) Rx)) (cadr a1)))
(setq a3 (list(car a2) (- (cadr p0) (* (cos (/ pi 4)) Rx))))
(setq a4 (list(car a1) (cadr a3)))
(setq b1 (list(+ (car p0) (* (cos (/ pi 4)) Rd)) (+ (cadr p0) (* (cos (/ pi 4)) Rd))))
(setq b2 (list(- (car p0) (* (cos (/ pi 4)) Rd)) (cadr b1)))
(setq b3 (list(car b2) (- (cadr p0) (* (cos (/ pi 4)) Rd))))
(setq b4 (list(car b1) (cadr b3)))
(Command "line" a1 a2 a3 a4 a1"")
(Command "line" b1 b2 b3 b4 b1"")
(Command "circle" p0 Rd)
(Command "circle" p0 RX)
)
(三)
(defun c:tuxing3 ()
(setq r (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq p1 (list(- (car p0) (* r 2)) (cadr p0)))
setq p2 (list(+ (car p0) (* r 2)) (cadr p0)))
((Command "circle" p0 r)
(Command "circle" p1 r)
(Command "circle" p2 r)
)
(四)
(defun c:tuxing4 ()
(setq r (getdist "\n r=:"))
(setq p0 (getPoint "\n Enter Center of Circle"))
(setq a1 (list(+ (car p0) (* (cos (/ pi 4)) r)) (+ (cadr p0) (* (cos (/ pi 4)) r))))
(setq a2 (list(- (car p0) (* (cos (/ pi 4)) r)) (cadr a1)))
(setq a3 (list(car a2) (- (cadr p0) (* (cos (/ pi 4)) r))))
(setq a4 (list(car a1) (cadr a3)))
(Command "line" a1 a2 a3 a4 a1"")
(Command "circle" p0 r)
)
可以了,你试试吧!
展开全部
(Defun C:T914 (/ lstCir i item strA)
(Defun GetCir (/ lstSS ss lstRet i en enData r pt)
(princ "\n请选择圆:")
(setq lstSS '((0 . "CIRCLE")))
(setq ss (vl-catch-all-apply 'ssget (list lstSS)))
(cond ((or (null ss) (vl-catch-all-error-p ss)) (vl-exit-with-value 0)))
(setq lstRet '())
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
i (1+ i)
enData (entget en)
r (cdr (assoc 40 enData))
r (rtos r 2 4)
pt (assoc 10 enData)
)
(if (assoc r lstRet)
(progn
(setq lstRet (subst (append (assoc r lstRet) (list pt)) (assoc r lstRet) lstRet))
)
(progn
(setq lstRet (cons (list r pt) lstRet))
)
)
)
)
;; ;;
;; ;;
(setq lstCir (GetCir))
(setq i 0)
(repeat (length lstCir)
(setq item (nth i lstCir)
i (1+ i)
strA (chr (+ i 65))
)
(foreach pt (cdr item)
(entmake
(list (cons 0 "Text") pt (cons 40 (* 0.4 (atof (car item)))) (cons 1 strA) (cons 62 3))
)
)
)
(prin1)
)
(Defun GetCir (/ lstSS ss lstRet i en enData r pt)
(princ "\n请选择圆:")
(setq lstSS '((0 . "CIRCLE")))
(setq ss (vl-catch-all-apply 'ssget (list lstSS)))
(cond ((or (null ss) (vl-catch-all-error-p ss)) (vl-exit-with-value 0)))
(setq lstRet '())
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i)
i (1+ i)
enData (entget en)
r (cdr (assoc 40 enData))
r (rtos r 2 4)
pt (assoc 10 enData)
)
(if (assoc r lstRet)
(progn
(setq lstRet (subst (append (assoc r lstRet) (list pt)) (assoc r lstRet) lstRet))
)
(progn
(setq lstRet (cons (list r pt) lstRet))
)
)
)
)
;; ;;
;; ;;
(setq lstCir (GetCir))
(setq i 0)
(repeat (length lstCir)
(setq item (nth i lstCir)
i (1+ i)
strA (chr (+ i 65))
)
(foreach pt (cdr item)
(entmake
(list (cons 0 "Text") pt (cons 40 (* 0.4 (atof (car item)))) (cons 1 strA) (cons 62 3))
)
)
)
(prin1)
)
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
aa
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询