(defun c:test2 ()
;;CAB version 1.1
;;Calling routine to pass a tangent point (p1) & offset distance (od)
;;Routine will allow user to stretch outer circle using diameter
;;Note if offset distance is a negative number the offset circle
;;will be on the outside
;;
;;Returns the 2nd pick point
(defun ghostCircle (p1 od / *error* p2 d1 c1 c2 el1 el2 gr rMin)
(defun *error* (msg)
(if (not
(member msg '("Console break" "Function cancelled" "quit / exit abort" "" nil))
)
(princ (strcat "\nError: " msg))
)
(and c1 (entdel c1))
(and c2 (entdel c2))
(princ)
) ; end error function
(setq rMin 0.001)
(setq c1
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq c2
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq el1 (entget c1)
el2 (entget c2)
)
;;p1 is a tangent point
;;p2 is a tangent point with center at mid point of p1 p2
(while (and (setq gr (grread 5)) (= (car gr) 5))
(cond
((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
(setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
(cond
((< rMin (- d1 od))
(setq el2 (subst (cons 40 (- d1 (/ od 2.))) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
(t ; minimize the inner circle
(setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
)
)
(t ; minimize the outer circle
(setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
)
)
)
(entdel c1)
(entdel c2)
p2
)
(setq pc (getpoint "\nPick center point."))
(princ "\n Select new radius")
(setq rad (ghostcircle pc 850.0))
(princ rad)
(princ)
)
伙计，看起来不错！但是起点必须在外圆上。内圈的偏移量必须保持在850。现在，当我把圆变大时，偏移量也会变大。你可以在日常生活中这样做吗？
最后但并非最不重要的一点是，现在它只显示了圆圈。也可以画吗？谢谢你，伙计！我一个人永远不可能想出那样的套路！ 不客气。
更改此
(entdel c1)
(entdel c2)
为了保持循环
; (entdel c1)
; (entdel c2)
然后改变这个
(setq rad (ghostcircle pc 850.0))
将点从内圈切换到外圈
(setq rad (ghostcircle pc -850.0))
好的，entdel部分工作了，但是由于某种原因将850改为-850没有效果。
内圈的偏移量必须保持在850。现在，当我把圆变大时，偏移量也会变大。 哎呀，数学错误修复了。试试1.2版
(defun c:test2 ()
;;CAB version 1.2
;;Calling routine to pass a tangent point (p1) & offset distance (od)
;;Routine will allow user to stretch outer circle using diameter
;;Note if offset distance is a negative number the offset circle
;;will be on the outside
;;
;;Returns the 2nd pick point
(defun ghostCircle (p1 od / *error* p2 d1 c1 c2 el1 el2 gr rMin)
(defun *error* (msg)
(if (not
(member msg '("Console break" "Function cancelled" "quit / exit abort" "" nil))
)
(princ (strcat "\nError: " msg))
)
(and c1 (entdel c1))
(and c2 (entdel c2))
(princ)
) ; end error function
(setq rMin 0.001) ; Minimum Radius allowed
(setq c1
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq c2
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq el1 (entget c1)
el2 (entget c2)
)
;;p1 is a tangent point
;;p2 is a tangent point with center at mid point of p1 p2
(while (and (setq gr (grread 5)) (= (car gr) 5))
(cond
((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
(setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
(cond
((< rMin (- d1 (* od 2.)))
(setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
(t ; minimize the inner circle
(setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
)
)
(t ; minimize the outer circle
(setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
)
)
)
;(entdel c1) ; to remove the circle
;(entdel c2) ; to remove the circle
p2
)
(setq pc (getpoint "\nPick center point."))
(princ "\n Select new radius")
(setq rad (ghostcircle pc 850.0))
(princ rad)
(princ)
) 令人惊叹的！
Thanx很多！这太棒了！现在我需要做的就是找出如何使其切换到特定层并返回。
为什么我不能捕捉第二个点，第二个点可能是圆的中心吗？我知道我很痛苦，但这是为了更好！ 这里有图层。将生成的层不存在。
注意，grread不支持Osnap。
要做到这一点，有一个相当长的程序。
但是我可以添加一个特征来捕捉，而不需要符号。
(defun c:test2 ()
;;CAB version 1.3
;;Calling routine to pass a tangent point (p1) & offset distance (od)
;;Routine will allow user to stretch outer circle using diameter
;;Note if offset distance is a negative number the offset circle
;;will be on the outside
;;LayName if nil will use the curent layer
;;Returns the 2nd pick point
(defun ghostCircle (p1 od LayName / *error* p2 d1 c1 c2 el1 el2 gr rMin)
(defun *error* (msg)
(if (not
(member msg '("Console break" "Function cancelled" "quit / exit abort" "" nil))
)
(princ (strcat "\nError: " msg))
)
(and c1 (entdel c1))
(and c2 (entdel c2))
(princ)
) ; end error function
(or layName (setq layName (getvar "clayer")))
(setq rMin 0.001) ; Minimum Radius allowed
(setq c1
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 LayName)
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq c2
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 LayName)
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq el1 (entget c1)
el2 (entget c2)
)
;;p1 is a tangent point
;;p2 is a tangent point with center at mid point of p1 p2
(while (and (setq gr (grread 5)) (= (car gr) 5))
(cond
((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
(setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
(cond
((< rMin (- d1 (* od 2.)))
(setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
(t ; minimize the inner circle
(setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
)
)
(t ; minimize the outer circle
(setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
)
)
)
;(entdel c1) ; to remove the circle
;(entdel c2) ; to remove the circle
p2
)
(setq pc (getpoint "\nPick center point."))
(princ "\n Select new radius")
(setq rad (ghostcircle pc 850.0 "0")) ; Layer name "0"
(princ rad)
(princ)
) 那么，如果我希望使用的层是“Hulplijnen”，我需要更改什么？
如果你至少能让它在没有符号的情况下折断，那就太棒了！
是否可以将第二个点从切线更改为圆心？ 换成这一行。我更新了上面的代码。
(setq rad (ghostcircle pc 850.0 "Hulplijnen")) ; Layer name "0"
我正在将osnap添加到下一个版本中，但我也在为一个漫长的周末打包&可能在我离开之前不会完成。 很少测试。
(defun c:test4 ()
;;CAB version 1.4
;;Calling routine to pass a tangent point (p1) & offset distance (od)
;;Routine will allow user to stretch outer circle using diameter
;;Note if offset distance is a negative number the offset circle
;;will be on the outside
;;LayName if nil will use the curent layer
;;os when true will use the osnap if it is active
;;Returns the 2nd pick point
(defun ghostCircle (p1 od layName os / *error* get_osmode p2 d1 c1 c2 el1 el2 gr rMin)
(defun *error* (msg)
(if (not
(member msg '("Console break" "Function cancelled" "quit / exit abort" "" nil))
)
(princ (strcat "\nError: " msg))
)
(and c1 (entdel c1))
(and c2 (entdel c2))
(princ)
) ; end error function
;;CAB10/5/2006
;;
;;Function to return the current osmode setting in the form of a string
;;If (getvar "osmode") = 175
;;(get_osmode)returns "_end,_mid,_cen,_nod,_int,_per"
;;Usage
;;(osnap (getpoint) (get_osmode))
;;
(defun get_osmode (/ cur_mode mode$)
(setq mode$ "")
(if (< 0 (setq cur_mode (getvar "osmode")) 16383)
(mapcar
'(lambda (x)
(if (not (zerop (logand cur_mode (car x))))
(setq mode$ (strcat mode$ (cadr x)))
) )
'((0 "_non,") (1 "_end,") (2 "_mid,") (4 "_cen,") (8 "_nod,") (16 "_qua,")
(32 "_int,") (64 "_ins,") (128 "_per,") (256 "_tan,") (512 "_nea,")
(1024 "_qui,") (2048 "_app,") (4096 "_ext,") (8192 "_par") )
)
)
mode$
)
(defun CircleUpdate (p1 p2 od rMin el1 el2 / d1 gr c1 c2)
(cond
((> (setq d1 (distance p1 p2)) rMin)
(setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
(cond
((< rMin (- d1 (* od 2.)))
(setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
(t ; minimize the inner circle
(setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
(setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
(entupd (cdr (assoc -1 el2)))
)
)
)
(t ; minimize the outer circle
(setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
(setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
(entupd (cdr (assoc -1 el1)))
)
)
p2
)
(or layName (setq layName (getvar "clayer")))
(setq rMin 0.001) ; Minimum Radius allowed
(setq c1
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 layName)
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq c2
(entmakex (list (cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 layName)
(cons 10 p1)
(cons 39 0.0)
(cons 40 rMin) ; radius
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
(setq el1 (entget c1)
el2 (entget c2)
)
;;p1 is a tangent point
;;p2 is a tangent point with center at mid point of p1 p2
(while (and (setq gr (grread 5)) (= (car gr) 5))
(setq p2 (CircleUpdate p1 (cadr gr) od rMin el1 el2))
)
;(entdel c1) ; to remove the circle
;(entdel c2) ; to remove the circle
(setq p2 (if os (osnap p2 (get_osmode))p2))
(or p2 (setq p2 (cadr gr))) ; catch any error with point
(CircleUpdate p1 p2 od rMin el1 el2)
p2
)
(setq pc (getpoint "\nPick center point."))
(princ "\n Select new radius")
(setq rad (ghostcircle pc 850.0 "0" t)) ; Layer name "0", t= use osmode if on
(princ rad)
(princ)
)
页:
1
[2]