用多边形绘制圆
嗨，亲爱的朋友。我需要一些帮助。用多边形绘制圆
1步。选择闭合对象，必须是多边形。
2步骤。输入偏移距离。
3步骤。输入圆的直径。
4步骤。选择多边形的内部或外部。
如。
例如，内部
例如，外部
在偏移多边形的顶点处绘制圆，然后删除该偏移。。。
按照marko的建议试试这个
(defun C:test (/ e sel d c p en)
;;;jdiala 09-06-14 Cadtutor.net ;;;
(vl-load-com)
(if
(setq e
(while
(not e)
(progn
(setq sel (entsel "\nSelect a polygon :"))
(cond
( (= nul sel)
(princ "\nMissed! ")
)
( (/= "LWPOLYLINE" (cdr (assoc 0 (entget (car sel)))))
(princ "\nInvalid selection. " )
)
( (and
(= "LWPOLYLINE" (cdr (assoc 0 (entget (car sel)))))
(= 1 (cdr (assoc 70 (entget (car sel)))))
)
(setq e sel))
(t nil)
)
)
)
d (getdist "\nEnter offset distance :")
c (/ (getdist "\nEnter diameter of circle :") 2.0)
p (getpoint "\nPick side to offset :")
)
(progn
(command "_.offset" d e p "")
(mapcar
(function
(lambda (z)
(entmake
(list
(cons 0 "CIRCLE")
(cons 10 (cdr z))
(cons 40 c)
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 (polar (cdr z) 0 (* c 1.5)))
(cons 11 (polar (cdr z) pi (* c 1.5)))
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 (polar (cdr z) (/ pi 2.) (* c 1.5)))
(cons 11 (polar (cdr z) (* pi 1.5) (* c 1.5)))
)
)
)
)
(vl-remove-if-not
(function
(lambda (x)
(= 10 (car x))
)
)
(entget
(setq en (entlast))
)
)
)
(entdel en)
)
)
(princ)
)
动态程序
(defun c:Test (/ _line _screw l lk s sn a p1 p2 gr ang o lst pts)
;; Author : Tharwat Al Shoufi ;;
;; Date : 07.Sep.2014 ;;
;; Dynamic draw a circle with a cross of line ;;
;; at specific offset distance of a polyline ;;
(defun _line (p q) (entmakex (list '(0 . "LINE") (cons 62 4) (cons 10 p) (cons 11 q))))
(defun _screw (pts r / lst 1p)
(mapcar '(lambda (p)
(setq lst (cons (entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r))) lst)
lst (cons (_line (setq 1p (polar p 0. (* r 1.2))) (polar p pi (* r 1.2))) lst)
lst (cons (_line (setq 1p (polar p (* pi 1.5) (* r 1.2))) (polar p (* pi 0.5) (* r 1.2))) lst)
)
)
pts
)
lst
)
(if (eq 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'clayer)))))))
(progn (alert "Warning ! Current layer is Locked") (setq lk t))
)
(setq l (entlast))
(if (and (not lk)
(setq s (entsel "\n Select a polyline :"))
(eq (cdr (assoc 0 (entget (setq sn (car s))))) "LWPOLYLINE")
(setq *dist* (cond ((getdist (strcat "\n Offset distance < "
(rtos (if *dist*
*dist*
(setq *dist* 1.0)
)
2
2
)
" > :"
)
)
)
(*dist*)
)
)
(setq *rad* (cond ((getdist (strcat "\n Specify radius of Circles < "
(rtos (if *rad*
*rad*
(setq *rad* 1.0)
)
2
2
)
" > :"
)
)
)
(*rad*)
)
)
)
(progn (setq a (fix (vlax-curve-getparamatpoint sn (vlax-curve-getclosestpointto sn (cadr s)))))
(setq p1 (vlax-curve-getpointatparam sn a))
(setq p2 (vlax-curve-getpointatparam sn (setq a (1+ a))))
(while (and (eq (car (setq gr (grread t 15 0))) 5)
(not (redraw))
(if (minusp (sin (- (angle p1 p2) (angle p2 (cadr gr)))))
(setq ang t)
(progn (setq ang nil) t)
)
)
(vla-offset
(vlax-ename->vla-object sn)
(if ang
(- *dist*)
*dist*
)
)
(if o
(entdel o)
)
(if lst
(mapcar 'entdel lst)
)
(if (not (eq (setq o (entlast)) l))
o
)
(setq l o
pts nil
)
(foreach x (entget o)
(if (eq (car x) 10)
(setq pts (cons (list (cadr x) (caddr x) 0.) pts))
)
)
(setq lst (_screw pts *rad*))
)
(if l
(entdel l)
)
)
)
(princ)
)
Tharwat干得好
以下是我的看法：
;; Polyline Circles-Lee Mac
;; Generates a set of circles with centerlines for every vertex of a selected polyline,
;; offset inside or outside by a given distance based on the cursor position.
(defun c:polyc ( / *error* dia ent enx flg lst obj ocs off par pt1 pt2 pt3 )
(defun *error* ( msg )
(foreach grp lst (foreach ent grp (if (entget ent) (entdel ent))))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect polyline: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (/= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
(princ "\nSelected object is not a polyline.")
)
)
)
)
(if (and (= 'ename (type ent))
(setq obj (vlax-ename->vla-object ent))
(setq off (getdistwithdefault "\nSpecify offset distance" 'polyc:off))
(setq dia (getdistwithdefault "\nSpecify circle diameter" 'polyc:dia))
(setq dia (/ dia 2.0)
ocs (assoc 210 enx)
)
)
(if
(apply 'and
(setq lst
(mapcar
(function
(lambda ( x )
(apply 'append
(mapcar
(function
(lambda ( y / r )
(setq r
(apply 'append
(mapcar
(function
(lambda ( p )
(cons (entmakex (list '(0 . "CIRCLE") p (cons 40 dia) ocs))
(mapcar
(function
(lambda ( a )
(entmakex
(list
'(0 . "LINE")
(cons 10 (trans (mapcar '+ (cdr p) a) (cdr ocs) 0))
(cons 11 (trans (mapcar '+ (cdr p) (mapcar '- a)) (cdr ocs) 0))
)
)
)
)
(list (list (* dia 1.5) 0.0) (list 0.0 (* dia 1.5)))
)
)
)
)
(vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget (vlax-vla-object->ename y)))
)
)
)
(vla-delete y)
r
)
)
x
)
)
)
)
(list
(catchapply 'vlax-invoke (list obj 'offset off))
(catchapply 'vlax-invoke (list obj 'offset (- off)))
)
)
)
)
(progn
(foreach ent (car lst) (entdel ent))
(princ "\nChoose offset side: ")
(while (= 5 (car (setq pt1 (grread t 13 0))))
(setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent (trans (cadr pt1) 1 0)))
pt2 (trans (vlax-curve-getpointatparam ent (fix par)) 0 1)
pt3 (trans (vlax-curve-getpointatparam ent (1+ (fix par))) 0 1)
)
(if (not (eq flg (setq flg (minusp (sin (- (angle pt2 (cadr pt1)) (angle pt2 pt3)))))))
(foreach grp lst (foreach ent grp (entdel ent)))
)
)
)
(progn
(princ "\nOffset distance too large - unable to perform internal offset.")
(foreach x (apply 'append lst) (entdel x))
)
)
)
(princ)
)
(defun getdistwithdefault ( msg sym )
(set sym (cond ((getdist (strcat msg (if (eval sym) (strcat " <" (rtos (eval sym)) ">: ") ": ")))) ((eval sym))))
)
(defun catchapply ( fun arg / rtn )
(if (not (vl-catch-all-error-p (setq rtn (vl-catch-all-apply fun arg)))) rtn)
)
(vl-load-com) (princ)
上述操作也应在所有UCS和视图中正确执行。
非常感谢，你的反馈对我来说意义重大 marko、jdiala、Tharwat、leemac
谢谢大家。
非常感动！
如果多边形不是pline，则它是闭合的直线。如何做？
如何更改中心线的图层？
在使用上述程序之前，请使用PEDIT>Join将线连接到多段线。
在我的代码中，更改：
'(0 . "LINE")
(cons 10 (trans (mapcar '+ (cdr p) a) (cdr ocs) 0))至：
'(0 . "LINE")
'(8 . "Your Layer Here")
(cons 10 (trans (mapcar '+ (cdr p) a) (cdr ocs) 0))
李，非常感谢！非常好！ 李，我只是不明白下面的代码在删除对象后如何重新生成它们。
你能帮我澄清一下吗？
(foreach grp lst (foreach ent grp (entdel ent)))
页:
[1]
2