TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on March 17, 2006, 12:36:12 PM
-
I would like to join the ends of two separate arc to form a arch header for my window program.
I started by drawing the bottom arc, then I offset the arc at a distance to get the second arc above. How would one join the endpoints to form the arch sill?
___
A / __ \ C
B / \ D
I would like to join A to B and C to D to form this;
____
A / ___ \ C
B |/ \| D
I hope that explains it a little better? :-D
Any help would be appreciated….
-
Could you post a small drawing showing exactly what you want the result to be?
-
How does one post a drawing?
I tried to provide a sketch of what I want in my original post. The first crude arc is what I have and the second is what I wish to achieve.
Thanks Jeff for any help!
-
Look under Additional Options... when you are posting.
-
Use the REPLY button, don't QuickReply. Under the window that you type your reply into you will see "Additional Options", click on that and you will see a way to Attach files......
-
My lisp can produce what is in the given.jpg file now.
I want to be able to produce what is shown in the final.jpg
Both jpg are attached to this post.
Hope this works
-
OK, last question before I help with a solution......code you post the code for creating the arc and it's offset?
-
Here is my code so far.
(Defun C:Hdr ()
(setq PNT (getpoint "\nWindow Insertion point: ")
DST (getdist PNT "\nWindow Length: ")
);
(setq LYR (getvar "CLAYER")
OSM (getvar "Osmode")
);
(setvar "Osmode" 0)
(setq HLF (/ DST 2)
A90 (D2R 90)
PTB (polar PNT 0 HLF)
PTB (polar PTB A90 8)
PTC (polar PNT 0 DST)
);
(command "_.Arc" PNT PTB PTC "")
(setq OBJ1 (entlast))
(command "_.Offset" 8 OBJ1 PTC "")
(setq OBJ2 (entlast))
;.....join arc ends...
);
D2R is just a lisp to change degrees to radians..
Hope it helps
-
(defun arc-radius (/ GR LST PT)
(princ "\n Select ARC ")
(setq lst (entget
(car (entsel))
) ;_ entget
pt (cdr (assoc 10 lst))
) ;_ setq
(while (and (setq gr (grread 5)) (= (car gr) 5))
(entmod (subst
(cons 40 (distance pt (cadr gr)))
(assoc 40 lst)
lst
) ;_ subst
) ;_ entmod
(entupd (cdr (assoc -1 lst)))
) ;_ while
) ;_ defun
(arc-radius)
-
Here ya go, Shade:
(Defun C:Hdr (/ A90 ARC2 DST ENDPT HLF LYR OBJ1 OBJ2 OSM PNT PTB PTC STARTPT)
(setq PNT (getpoint "\nWindow Insertion point: ")
DST (getdist PNT "\nWindow Length: ")
);
(setq LYR (getvar "CLAYER")
OSM (getvar "Osmode")
);
(setvar "Osmode" 0)
(setq HLF (/ DST 2)
A90 (/ pi 2)
PTB (polar PNT 0 HLF)
PTB (polar PTB A90 8)
PTC (polar PNT 0 DST)
);
(command "_.Arc" PNT PTB PTC)
(setq OBJ1 (entlast))
(command "_.Offset" 8 OBJ1 PTC "")
(setq OBJ2 (entlast))
(setq arc2 (entget obj2))
(setq startpt (polar (cdr (assoc 10 arc2)) (cdr (assoc 50 arc2)) (cdr (assoc 40 arc2)))
endpt (polar (cdr (assoc 10 arc2)) (cdr (assoc 51 arc2)) (cdr (assoc 40 arc2)))
)
;.....join arc ends...
(if (< (distance PNT startpt) (distance ptC startpt))
(progn
(command ".line" PNT startpt "")
(command ".line" ptC endpt "")
)
(progn
(command ".line" ptC startpt "")
(command ".line" PNT endpt "")
)
)
(princ)
);
-
I like it, and I just could not keep my hands off..........
;;;by Jeff Mishler
(Defun c:hdr (/ A90 ARC2 DST ENDPT HLF LYR OBJ1 OBJ2 OSM PNT PTB PTC STARTPT archght1 archght2)
;(ARCH:F_S-VAR)
;(ARCH:CUSTOM_LAYERS-LINE-02)
(setq PNT (getpoint "\n* Pick Arch Insertion point *")
DST (getdist PNT "\n* Pick Arch Width <second point of arch> *"))
(setq LYR (getvar "CLAYER")
OSM (getvar "Osmode"))
(setvar "Osmode" 0)
(setq archght1 (getreal "\n* Enter Arch Height <6>: "))
(if (not archght1)(setq archght1 6))
(setq HLF (/ DST 2)
A90 (/ pi 2)
PTB (polar PNT 0 HLF)
PTB (polar PTB A90 archght1)
PTC (polar PNT 0 DST))
(command "_.Arc" PNT PTB PTC)
(setq OBJ1 (entlast))
(setq archght2 (getreal "\n* Enter Arch Offset <9>: "))
(if (not archght2)(setq archght2 9))
(command "_.Offset" archght2 OBJ1 PTC "")
(setq OBJ2 (entlast))
(setq arc2 (entget obj2))
(setq startpt (polar (cdr (assoc 10 arc2))
(cdr (assoc 50 arc2))
(cdr (assoc 40 arc2)))
endpt (polar (cdr (assoc 10 arc2))
(cdr (assoc 51 arc2))
(cdr (assoc 40 arc2))))
(if (< (distance PNT startpt) (distance ptC startpt))
(progn (command ".line" PNT startpt "") (command ".line" ptC endpt ""))
(progn (command ".line" ptC startpt "") (command ".line" PNT endpt "")))
;(ARCH:F_R-VAR)
(princ))
Gary
-
(defun c:test (/ GR LST PT)
(vl-load-com)
(setq lst (vlax-ename->vla-object (car (entsel "\n*** Select ARC *** ")))
pt (vlax-safearray->list (vlax-variant-value (vla-get-center lst)))
lst (list
lst
(vlax-ename->vla-object
(entmakex
(apply (function (lambda (x) (list '(0 . "LINE") (cons 10 x) (cons 11 x))))
(list (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint lst))))
) ;_ apply
) ;_ entmakex
) ;_ vlax-ename->vla-object
(vlax-ename->vla-object
(entmakex
(apply (function (lambda (x) (list '(0 . "LINE") (cons 10 x) (cons 11 x))))
(list (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint lst))))
) ;_ apply
) ;_ entmakex
) ;_ vlax-ename->vla-object
(vla-copy lst)
) ;_ list
) ;_ setq
(princ "\n Set visually width or enter from the keyboard: \t")
(while (and (setq gr (grread 5)) (= (car gr) 5))
(vla-put-radius (car lst) (distance pt (cadr gr)))
(vla-put-EndPoint (cadr lst) (vla-get-StartPoint (car lst)))
(vla-put-EndPoint (caddr lst) (vla-get-EndPoint (car lst)))
(mapcar (function vla-update) lst)
) ;_ while
(if (= (car gr) 2)
(progn
(vla-put-radius (car lst)
(+ (vla-get-radius (last lst))
(atof (strcat (princ (vl-list->string (cdr gr))) (getstring)))
) ;_ +
) ;_ vla-put-radius
(vla-put-EndPoint (cadr lst) (vla-get-StartPoint (car lst)))
(vla-put-EndPoint (caddr lst) (vla-get-EndPoint (car lst)))
(mapcar (function vla-update) lst)
) ;_ progn
) ;_ if
(princ)
) ;_ defun
(c:test)
-
(defun c:test_1 (/ GR LST)
(vl-load-com)
(setq
lst (vlax-ename->vla-object
(car
(entsel "\n*** Select ARC *** ")
) ;_ car
) ;_ vlax-ename->vla-object
lst (list
lst
(vla-get-startangle lst)
(vla-get-endangle lst)
(vlax-safearray->list
(vlax-variant-value
(vla-get-center lst)
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
(vlax-ename->vla-object
(entmakex
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(62 . 1)
'(100
.
"AcDbPolyline"
)
'(90 . 4)
'(70 . 1)
) ;_ list
(apply
(function
(lambda (a b c)
(list
a
(cons 42 b)
c
'(42 . 0.)
c
(cons 42 (- b))
a
'(42 . 0.)
) ;_ list
) ;_ lambda
) ;_ function
(list
(cons
10
(reverse
(cdr
(reverse
(vlax-safearray->list
(vlax-variant-value
(vla-get-StartPoint lst)
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ cons
((lambda (a)
(/ (sin a) (cos a))
) ;_ lambda
(/ (vla-get-Totalangle lst) 4.)
)
(cons
10
(reverse
(cdr
(reverse
(vlax-safearray->list
(vlax-variant-value
(vla-get-EndPoint lst)
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ cons
) ;_ list
) ;_ apply
) ;_ apply
) ;_ entmakex
) ;_ vlax-ename->vla-object
) ;_ list
) ;_ setq
(vla-delete (car lst))
(setq lst (cdr lst))
(princ "\n Set visually width or enter from the keyboard: \t")
(while
(and
(setq gr (grread 5))
(= (car gr) 5)
) ;_ and
(vla-put-Coordinate
(cadddr lst)
0.
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray 5 '(0 . 1))
(reverse
(cdr
(reverse
(polar
(caddr lst)
(car lst)
(distance (caddr lst) (cadr gr))
) ;_ polar
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ vlax-safearray-fill
) ;_ vlax-make-variant
) ;_ vla-put-Coordinate
(vla-put-Coordinate
(cadddr lst)
1.
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray 5 '(0 . 1))
(reverse
(cdr
(reverse
(polar
(caddr lst)
(cadr lst)
(distance (caddr lst) (cadr gr))
) ;_ polar
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ vlax-safearray-fill
) ;_ vlax-make-variant
) ;_ vla-put-Coordinate
) ;_ while
(if (= (car gr) 2)
(progn
(setq
gr (atof
(strcat
(princ
(vl-list->string
(cdr gr)
) ;_ vl-list->string
) ;_ princ
(getstring)
) ;_ strcat
) ;_ atof
) ;_ setq
(vla-put-Coordinate
(cadddr lst)
0.
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray 5 '(0 . 1))
(reverse
(cdr
(reverse
(polar
(caddr lst)
(car lst)
(+ gr
(distance
(caddr lst)
(vlax-safearray->list
(vlax-variant-value
(vla-get-Coordinate
(cadddr lst)
3.
) ;_ vla-get-Coordinate
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ distance
) ;_ +
) ;_ polar
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ vlax-safearray-fill
) ;_ vlax-make-variant
) ;_ vla-put-Coordinate
(vla-put-Coordinate
(cadddr lst)
1.
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray 5 '(0 . 1))
(reverse
(cdr
(reverse
(polar
(caddr lst)
(cadr lst)
(+ gr
(distance
(caddr lst)
(vlax-safearray->list
(vlax-variant-value
(vla-get-Coordinate
(cadddr lst)
2.
) ;_ vla-get-Coordinate
) ;_ vlax-variant-value
) ;_ vlax-safearray->list
) ;_ distance
) ;_ +
) ;_ polar
) ;_ reverse
) ;_ cdr
) ;_ reverse
) ;_ vlax-safearray-fill
) ;_ vlax-make-variant
) ;_ vla-put-Coordinate
) ;_ progn
) ;_ if
(princ)
) ;_ defun
(c:test_1)
It is a variant with usage of a polyline... :-)
-
Thanks everyone for the help! I learned alot.
I see I still have lots to learn also.
This place is the best. :mrgreen:
-
Does anyone have a lisp that hatches a brick arch? I thought I had seen one here sometime ago, unfortunately I never saved it and I can't seem to find it with the search engine. :-(
-
Does anyone have a lisp that hatches a brick arch? I thought I had seen one here sometime ago, unfortunately I never saved it and I can't seem to find it with the search engine. :-(
Use quickarray.lsp by Fatty
Gary