Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/22/2023 in all areas

  1. Wow it was already great, but you've made it even better, Steven. I'll study your codes for sure. Thank you for going above and beyond, Steven!
    1 point
  2. Based on wall insulation code I have of straights and arcs using just the pline command with option of a "Arc" would be feasible also, though the code by lee would be hard to beat. May have a go also using plain pline commands. Could add radius options in a range like 0.5 - 2.5 but more than likely will be fixed. Another ; pline with arcs by AlanH April 2023 (defun c:wow ( / pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 dist ang rad) (setq rad 1) (setq pt1 (getpoint "\nPick start point ")) (setq pt11 (getpoint pt1 "\nPick end point ")) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ang (angle pt1 pt11)) (setq dist (distance pt1 pt11)) ; do like Lee check dist is long enough (setq pt2 (polar (polar pt1 ang rad) (+ ang (* 1.25 pi)) rad)) (setq pt3 (polar (polar pt1 ang rad) (- ang (/ pi 2)) rad)) (setq pt4 (polar pt3 ang (- (/ dist 2.0) (* 2.0 rad)))) (setq pt5 (polar (polar pt4 (- ang (/ pi 2.)) rad)(+ ang (* 0.25 pi)) rad)) (setq pt6 (polar (polar pt4 ang rad) (- ang (/ pi 2)) rad)) (setq pt7 (polar (polar pt6 ang rad) (+ ang (* 0.75 pi)) rad)) (setq pt8 (polar pt4 ang (* 2.0 rad))) (setq pt9 (polar pt8 ang (- (/ dist 2.0) (* 2.0 rad)))) (setq pt10 (polar (polar pt11 (+ pi ang) rad) (+ ang (* 1.75 pi)) rad)) (command "pLINE" pt1 "w" 0.0 0.0 "arc" "s" pt2 pt3 "L" pt4 "arc" "s" pt5 pt6 "arc" "s" pt7 pt8 "L" pt9 "arc" "s" pt10 pt11 "") (setvar 'osmode oldsnap) (princ) )
    1 point
  3. @Emmanuel Delay Have you thought about using a block for this? (defun c:foo (/ d p1 p2) (cond ((null (tblobjname "block" "Brace")) (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "Brace") (10 0. 0. 0.) (70 . 0) ) ) (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 7) (70 . 0) (43 . 0.) (38 . 0.) (39 . 0.) (10 -0.5 0.) (40 . 0.) (41 . 0.) (42 . 0.414213562373095) (91 . 0) (10 -0.4 -0.1) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) (10 -0.1 -0.1) (40 . 0.) (41 . 0.) (42 . -0.414213562373095) (91 . 0) (10 0. -0.2) (40 . 0.) (41 . 0.) (42 . -0.414213562373095) (91 . 0) (10 0.1 -0.1) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) (10 0.4 -0.1) (40 . 0.) (41 . 0.) (42 . 0.414213562373095) (91 . 0) (10 0.5 0.) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) ) ) (if (and (setq p1 (getpoint "\nPick first point: ")) (setq p2 (getpoint p1 "\nPick second point: ")) ) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(8 . "Brace") '(100 . "AcDbBlockReference") '(2 . "Brace") (cons 10 (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) (cons 41 (setq d (distance p1 p2))) (cons 42 d) (cons 43 d) (cons 50 (angle p1 p2)) ) ) ) (princ) )
    1 point
  4. Here's another - (defun c:brace ( / ang blg di1 di2 mat rad pt1 pt2 ) (setq rad 1.0) ;; Brace radius (if (and (setq pt1 (getpoint "\nSpecify 1st point for brace: ")) (progn (while (and (setq pt2 (getpoint "\nSpecify 2nd point for brace: " pt1)) (< (distance pt1 pt2) (* 4 rad)) ) (princ "\nDistance between the two points must be greater than 4 times the radius.") ) pt2 ) ) (progn (setq di1 (distance pt1 pt2) di2 (- (/ di1 2.0) rad) ang (angle pt1 pt2) mat (list (list (cos ang) (- (sin ang))) (list (sin ang) (cos ang))) blg (1- (sqrt 2.0)) ) (entmake (append '( (000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 7) (070 . 0) ) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 010 (mapcar '+ (mapcar '(lambda ( r ) (apply '+ (mapcar '* r a))) mat) pt1)) (cons 042 b) ) ) ) (list '(0.0 0.0) (list rad (- rad)) (list di2 (- rad)) (list (+ di2 rad) (- 0 rad rad)) (list (- di1 di2) (- rad)) (list (- di1 rad) (- rad)) (list di1 0.0) ) (list blg 0.0 (- blg) (- blg) 0.0 blg 0.0) ) ) (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))) ) ) ) ) (princ) ) To flip the brace, pick the points in the opposite direction.
    1 point
  5. Here you go... (defun c:accolade ( / *error* LM:3pcircle LM:3parc pea cmd r p1 p2 a arc1 li1 arc2 arc3 li2 arc4 ss ) (defun *error* ( m ) (if cmd (setvar 'cmdecho cmd) ) (if pea (setvar 'peditaccept pea) ) (if m (prompt m) ) (princ) ) ;; 3-Point Circle - Lee Mac ;; Returns the center (UCS) and radius of the circle defined by three supplied points (UCS). (defun LM:3pcircle ( pt1 pt2 pt3 / cen md1 md2 vc1 vc2 ) (if (and (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)) (setq md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3)) (setq vc1 (mapcar '- pt2 pt1)) (setq vc2 (mapcar '- pt3 pt2)) (setq cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0)) md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0)) nil ) ) ) (list cen (distance cen pt1)) ) ) (defun LM:3parc ( pt1 pt2 pt3 / lst ocs arc ) (if (setq ocs (trans '(0.0 0.0 1.0) 1 0 t)) (if (setq lst (LM:3pcircle pt1 pt2 pt3)) (progn (if (minusp (sin (- (angle pt1 pt3) (angle pt1 pt2)))) (mapcar 'set '(pt1 pt3) (list pt3 pt1)) ) (setq arc (entmakex (list '(000 . "ARC") (cons 010 (trans (car lst) 1 ocs)) (cons 040 (cadr lst)) (cons 050 (angle (trans (car lst) 1 ocs) (trans pt1 1 ocs))) (cons 051 (angle (trans (car lst) 1 ocs) (trans pt3 1 ocs))) (cons 210 ocs) ) ) ) ) (princ "\nPoints are collinear.") ) ) (if arc arc ) ) (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (if (and (not (initget 7)) (setq r (getdist "\nPick or specify radius of arcs : ")) (not (initget 1)) (setq p1 (getpoint "\nPick or specify p1 : ")) (not (initget 1)) (setq p2 (getpoint p1 "\nPick or specify p2 : ")) (> (distance p1 p2) (* 2.0 r)) (setq a (angle p1 p2)) (setq arc1 (LM:3parc (polar p1 (rem (+ a pi) (* 2 pi)) r) (polar p1 (rem (+ a (* 1.25 pi)) (* 2 pi)) r) (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r))) (setq li1 (entmakex (list (cons 0 "LINE") (cons 10 (trans (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) 1 0)) (cons 11 (trans (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (- (/ (distance p1 p2) 2.0) r)) 1 0))))) (setq arc2 (LM:3parc (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (- (/ (distance p1 p2) 2.0) r)) (polar (polar (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (- (/ (distance p1 p2) 2.0) r)) (rem (+ a (* 1.5 pi)) (* 2 pi)) r) (rem (+ a (* 0.25 pi)) (* 2 pi)) r) (polar (polar (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (- (/ (distance p1 p2) 2.0) r)) (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a r))) (setq arc3 (LM:3parc (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (+ (/ (distance p1 p2) 2.0) r)) (polar (polar (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (+ (/ (distance p1 p2) 2.0) r)) (rem (+ a (* 1.5 pi)) (* 2 pi)) r) (rem (+ a (* 0.75 pi)) (* 2 pi)) r) (polar (polar (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (+ (/ (distance p1 p2) 2.0) r)) (rem (+ a (* 1.5 pi)) (* 2 pi)) r) (rem (+ a pi) (* 2 pi)) r))) (setq li2 (entmakex (list (cons 0 "LINE") (cons 10 (trans (polar (polar p1 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) a (+ (/ (distance p1 p2) 2.0) r)) 1 0)) (cons 11 (trans (polar p2 (rem (+ a (* 1.5 pi)) (* 2 pi)) r) 1 0))))) (setq arc4 (LM:3parc (polar p2 a r) (polar p2 (rem (- a (* 0.25 pi)) (* 2 pi)) r) (polar p2 (rem (- a (* 0.5 pi)) (* 2 pi)) r))) ) (progn (setq ss (ssadd)) (ssadd arc1 ss) (ssadd li1 ss) (ssadd arc2 ss) (ssadd arc3 ss) (ssadd li2 ss) (ssadd arc4 ss) (vl-cmdf "_.PEDIT" "_M" ss "" "_J") (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) ) ) (*error* nil) ) HTH. M.R.
    1 point
  6. That's no problem, it was all copy and pasted from other things. I have updated the code slightly so that the prefix and suffix text is at the start (easier to find and change when it is there), but also commented out 2 lines containing 'getstring' - remove the ; and the LISP will ask the for user input for the text to add
    1 point
  7. There is a change arc radius and it maintains tangency, which sounds much better than move just mid pt. Dynamic fillet.lsp
    1 point
×
×
  • Create New...