我没有机会尝试你的常规动作，但稍后我会的。
然而，我设法（以一种可能很奇怪的方式）将我想要的东西编码为代码：
; First you draw a line (x------x),and then it draws the square like this:
; *****************************
;the drawn square -> * *
; * *
; * *
; * *
; x-------------*-------------x <- the drawn line
; * *
; * *
; * *
; * *
; *****************************
(defun C:Square-FullSide ( / *error* oldcmech oldosm tmp-line vla-tmp-line end1 end2 midpt line-ang tmp-circle vla-tmp-circle bbox mn mx rec)
(defun *error* ( msg )
(if oldosm (setvar 'osmode oldosm))
(if oldcmech (setvar 'cmdecho oldcmech))
(if (and (= 'ename (type tmp-line)) (entget tmp-line))
(entdel tmp-line)
)
(if (and (= 'ename (type tmp-circle)) (entget tmp-circle))
(entdel tmp-circle)
)
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(while
(or
(command "_.line" pause pause "")
(and (setq tmp-line (entlast)) (eq (cdr (assoc 0 (entget tmp-line))) "LINE") )
)
(progn
(setq oldcmech (getvar 'cmdecho))
(setq oldosm (getvar 'osmode))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq end1 (cdr (assoc 10 (entget tmp-line))))
(setq end2 (cdr (assoc 11 (entget tmp-line))))
(setq midpt (mid end1 end2))
(setq ang (angle end1 end2))
(setq vla-tmp-line (vlax-ename->vla-object tmp-line))
(setq line-ang (vla-get-angle vla-tmp-line))
(command "_.circle" "2p" end1 end2)
(setq tmp-circle (entlast))
(setq vla-tmp-circle (vlax-ename->vla-object tmp-circle))
(setq bbox (vla-getboundingbox vla-tmp-circle 'mn 'mx))
(command "_.rectangle" (trans (vlax-safearray->list mn) 0 1)
(trans (vlax-safearray->list mx) 0 1) )
(setq rec (entlast))
(command "_.rotate" rec "" midpt (angtos line-ang))
(vla-delete vla-tmp-circle)
(vla-delete vla-tmp-line)
(setvar 'osmode oldosm)
(setvar 'cmdecho oldcmech)
);progn
);if
(princ)
)
(defun mid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)
; First you draw a line (x------x),and then it draws the square like this:
; *****************************
;the drawn square -> * *
; * *
; * *
; * *
; * x-------------x <- the drawn line
; * *
; * *
; * *
; * *
; *****************************
(defun C:Square-Halfside (/)
(while T
(command "_.polygon" 4 pause "C" pause)
)
(princ)
)
这里有一种替代方法：
(defun c:test(/ p1 p2 ang dis lst)
(if (and (setq p1 (getpoint "\nSpecify first point :"))
(setq p2 (getpoint "\nNext point :" p1))
)
(progn
(setq p1(trans p1 1 0)
p2(trans p2 1 0)
ang (angle p1 p2)
dis (/ (distance p1 p2) 2.)
)
(mapcar
'(lambda (x)
(setq
lst (cons (list (polar x (+ ang (* pi 0.5)) dis)
(polar x (+ ang (* pi 1.5)) dis)
)
lst)))
(list p1 p2)
)
(setq lst (apply 'append lst))
(entmakex (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(cons 10 (car lst))
(cons 10 (cadr lst))
(cons 10 (last lst))
(cons 10 (caddr lst))
)
)
)
)
(princ)
)
我的$0.05对于矩形拾取点，输入L，输入W，输入ang，然后使用双极的第一原理计算cnr点，使W空白，得到一个正方形，如果空白，则角度相同，然后其水平。请看下面的lisp。
可能为L拖动一条线，与为W拖动一条线相同，但使用第一条线的中心点。
像其他人一样，他们可能已经完成了，我刚刚添加了前端。
简单。lsp Not yet, but by looking at it I can expect how it would work.
Its missing that vector line I need to define the square rotation, try the routine I posted.
Still I have there 4 send commands - and I'm not sure can I avoid them .
And the 4th send command is the rotation issue I asked for in post #8.
EDIT: Well your first example I implemented in the "Square-HalfSide" function. You did not mention how you would like to create that rectangle !
Do you have a circle and you wan to select it then draw the box or specify a point with radius then draw a circle wrapped with a box .... etc? Sorry Tharwat,
But for what I was asking for, your first post gave me the needed answer! Then i just decided to do this other method like in the "Square-FullSide" function. Your 2nd example and Lee's are great, I know they require existing circle, but I have no problems at modifying the codes. I don't blame you at anything, just wanted to show the results that might be useful to someone. And yeah, the code I posted is based on what I have learnt from you and Lee in this forum... Simply like this would be enough in my opinion:
(defun c:test(/ p1 p2 ang dis lst) (if (and (setq p1 (getpoint "\nSpecify first point :")) (setq p2 (getpoint "\nNext point :" p1)) ) (progn (setq p1(trans p1 1 0) p2(trans p2 1 0) ang (angle p1 p2) dis (/ (distance p1 p2) 2.) ) (mapcar '(lambda (x) (setq lst (cons (list (polar x (+ ang (* pi 0.5)) dis) (polar x (+ ang (* pi 1.5)) dis) ) lst))) (list p1 p2) ) (setq lst (apply 'append lst)) (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 (car lst)) (cons 10 (cadr lst)) (cons 10 (last lst)) (cons 10 (caddr lst)) ) ) ) ) (princ) ) Here's an alternative method:
(defun c:test ( / a b n p q u v w ) (and(setq p (getpoint "\nSpecify 1st point: ")) (setq q (getpoint "\nSpecify 2nd point: " p)) (setq v (mapcar '/ (mapcar '- q p) '(2 2)) u (list (- (cadr v)) (car v)) w (list (cadr v) (- (car v))) n (trans '(0 0 1) 1 0 t) ) (entmake (vl-list* '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 4) '(070 . 1) (cons 210 n) (mapcar '(lambda ( a b ) (cons 10 (trans (mapcar '+ a b) 1 n))) (list p q q p) (list w w u u) ) ) ) ) (princ)) My $0.05 for a rectang Pick pt, Enter L, Enter W, Enter ang and use 1st principles of a double polar to work out cnr points Make the w blank and you get a square, same with angle if blank then its horizontal. Look at lisp below.
Maybe drag a line For L same for W but use centre pt of first line.
Like others their is probably one already done I just added the front end.
simplepit.lsp
页:
1
[2]