画一个正方形

Grrr · 发表于 2022-7-5 18:14:39

Tharwat和Lee mac，
我没有机会尝试你的常规动作，但稍后我会的。
然而，我设法（以一种可能很奇怪的方式）将我想要的东西编码为代码：

; 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)
)

Tharwat · 发表于 2022-7-5 18:18:22

这里有一种替代方法：

copy


(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)
 )

Grrr · 发表于 2022-7-5 18:21:18

我的$0.05对于矩形拾取点，输入L，输入W，输入ang，然后使用双极的第一原理计算cnr点，使W空白，得到一个正方形，如果空白，则角度相同，然后其水平。请看下面的lisp。

可能为L拖动一条线，与为W拖动一条线相同，但使用第一条线的中心点。
像其他人一样，他们可能已经完成了，我刚刚添加了前端。

简单。lsp

Tharwat · 发表于 2022-7-5 18:25:05

Grrr · 发表于 2022-7-5 18:27:29

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 [well maybe some of them with entmake].
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.

Tharwat · 发表于 2022-7-5 18:29:37

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?

Grrr · 发表于 2022-7-5 18:35:34

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...

Tharwat · 发表于 2022-7-5 18:38:15

Simply like this would be enough in my opinion:

copy

(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) )

Lee Mac · 发表于 2022-7-5 18:40:58

Here's an alternative method:

copy

(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))

BIGAL · 发表于 2022-7-5 18:43:42

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

[编程交流] 画一个正方形

发表回复

精选推荐