Leaderboard

Like tombu had signature block insert into all layouts etc .Paper copy was signed legal requirement.

I am trying to pull a cross shaped region up to a slanted mounting brace, but when I do it, it won't stop along the slant. It protrudes through and beyond the solid brace. I tried moving my UCS to the top of the line aligned with the slanted solid on the top. Any suggestions? Thanks presspull1.dwg

Just pointing out how complex the code could be when you could simply use snap from the vertex to midpoint between those two endpoints for the direction. AutoCAD - Snap From - https://www.google.com/search?q=autocad+snap+from&rlz=1C1RXQR_enUS986US986&oq=autocad+snap+from&gs_lcrp=EgZjaHJvbWUqBwgAEAAYgAQyBwgAEAAYgAQyCAgBEAAYFhgeMggIAhAAGBYYHjIICAMQABgWGB4yCAgEEAAYFhgeMggIBRAAGBYYHjIICAYQABgWGB4yCAgHEAAYFhgeMggICBAAGBYYHjIICAkQABgWGB7SAQkxMjUxMWowajeoAgCwAgA&sourceid=chrome&ie=UTF-8#fpstate=ive&vld=cid:15476a18,vid:gbWQ8Gh0r9Q,st:0

XData is essentially an additional bit of information added to the entity definition, it doesn't change how the entity is shown on the screen. What you want to do can be done, and this link is a good description https://www.afralisp.net/autolisp/tutorials/extended-entity-data-part-1.php

Easiest to code would include picking the vertex and the two endpoints. For bisecting using lines and polylines see: http://www.cadtutor.net/forum/showthread.php?100709-Draw-bisector-line&p=684958&viewfull=1#post684958

Use (princ (strcat "\n" stringa)) will princ on a new line.

Thank you fuccaro for comment, as you know some people just keep asking as they can not be bothered to learn and want it all for free, despite the 8 hours of coding required. Thats why in the doc file there are a couple of programs that I have spent hours on getting them to work compared to the like 2-3 seconds for a result. Duke has been in touch with me and happy to provide him with support at no cost as he embarks on the learning curve. Always good to see people wanting to learn. What is interesting is my clients have chased me and they are all over the world, only a couple local.

[XDrX-PlugIn(159)] Create snake line over a circle (theswamp.org) https://www.theswamp.org/index.php?topic=59526.0 (defun c:xdtb_snakecircle (/ an box cir direc dist e1 e2 endln ents ents-pair ept1 ept2 firstln garc i ints items ln1 ln2 mode p1extend pl ptmid pts1 pts2 spt1 spt2 x y ) (defun _make-sharp-corners (direc) (setq items (nth direc ents-pair) e1 (car items) e2 (cadr items) ept2 (xdrx-curve-getendpoint e2) spt2 (xdrx-curve-getstartpoint e2) spt1 (xdrx-curve-getstartpoint e1) ept1 (xdrx-curve-getendpoint e1) ) (cond ((= (rem direc 2) 0) (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" ept2 t ) ptmid (xdrx-line-midp ept2 p1extend) ) (xdrx-curve-setsptept e1 ept1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid ept2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" ept1 t ) ptmid (xdrx-line-midp ept1 p1extend) ) (xdrx-curve-setsptept e2 ept2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid 0 (distance ptmid ept1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid ept1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid 0 (* (distance ptmid ept1) 1.3))) (xdrx-line-make ept1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) (t (if (< direc (/ #xd-var-global-divide-nums 2.0)) (progn (setq p1extend (xdrx-getpropertyvalue (list spt1 ept1) "getclosestpointto" spt2 t ) ptmid (xdrx-line-midp spt2 p1extend) ) (xdrx-curve-setsptept e1 spt1 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt2))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt2 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt2) 1.3))) (xdrx-line-make p1extend ptmid) (xdrx-line-make ptmid spt2) ) ) ) (progn (setq p1extend (xdrx-getpropertyvalue (list spt2 ept2) "getclosestpointto" spt1 t ) ptmid (xdrx-line-midp spt1 p1extend) ) (xdrx-curve-setsptept e2 spt2 p1extend) (if (= #xd-var-global-mode "1") (progn (setq ptmid (polar ptmid pi (distance ptmid spt1))) (setq garc (xdge::constructor "kCircArc3d" p1extend ptmid spt1 ) ) (xdrx-entity-make garc) ) (progn (setq ptmid (polar ptmid pi (* (distance ptmid spt1) 1.3))) (xdrx-line-make spt1 ptmid) (xdrx-line-make ptmid p1extend) ) ) ) ) ) ) ) (setq #xd-var-global-mode "0") (xdrx-initget 0 "0 1") (if (setq mode (getkword (xdrx-string-formatex (xdrx-string-multilanguage "\n模式[标准(0)/圆弧(1)]<1>" "\nMode[standard(0)/arc(1)]<%s>") #xd-var-global-mode ) ) ) (setq #xd-var-global-mode mode) ) (xdrx-initget) (xd::doc:getint (xdrx-string-multilanguage "\n等分数" "\nDivide Nums") "#xd-var-global-divide-nums" 20 ) (if (setq cir (car (xdrx-entsel (xdrx-string-multilanguage "\n拾取圆<退出>:" "\nPick Circle<Exit>:") '((0 . "circle")) ) ) ) (progn (xdrx-begin) (xdrx-setmark) (setq box (xdrx-entity-box cir) ln1 (list (nth 3 box) (nth 0 box)) pts1 (xdrx-getpropertyvalue ln1 "getsamplepoints" #xd-var-global-divide-nums ) ln2 (list (nth 2 box) (nth 1 box)) pts2 (xdrx-getpropertyvalue ln2 "getsamplepoints" #xd-var-global-divide-nums ) an (angle (car pts2) (car pts1)) firstln (list (polar (car pts1) an (/ (distance (car pts1) (car pts2) ) 7.0 ) ) (car pts2) ) an (angle (car pts1) (car pts2)) dist (/ (distance (last pts1) (last pts2)) 7.0) endln (if (= (rem #xd-var-global-divide-nums 2) 1) (list (polar (last pts1) (+ an pi) dist) (last pts2)) (list (last pts1) (polar (last pts2) an dist)) ) pts1 (cdr (xd::list:removetail pts1)) pts2 (cdr (xd::list:removetail pts2)) ents nil ) (xdrx-line-make firstln) (setq ents (cons (entlast) ents)) (mapcar '(lambda (x y) (setq ints (xdrx-entity-intersectwith (list x y) cir) ints (xdrx-points-sortoncurve (list x y) ints) ) (apply 'xdrx-line-make ints ) (setq ents (cons (entlast) ents)) ) pts1 pts2 ) (xdrx-line-make endln) (setq ents (cons (entlast) ents) ents (reverse ents) ents-pair (xd::list:snakepair ents) ) (setq i -1) (repeat (length ents-pair) (setq i (1+ i)) (_make-sharp-corners i) ) (xdrx-curve-join (xdrx-getss)) (setq pl (entlast)) (xdrx-entity-setcolor pl 1) (xdrx-end) ) ) (princ) ) ===================== The above code uses XDrx API, download link: https://github.com/xdcad/XDrx-API-zip https://sourceforge.net/projects/xdrx-api-zip/ Dual version link: https://github.com/xdcad

Have a look at sites like Afralisp, Lee-mac.com, they have lots of great programs, and learning experiences. Your welcome to have a look at the attached, majority are free, a few I charge for normally Beer money. The reason I charge for some is that have to customize the code to suit client needs, an example 1 client doing manual task of editing a dwg made by external software could take up to 3 hours, it now takes 2 minutes. When you compare drafters hourly rate to 2 minutes cost saving is massive. Another charged for is 1150 lines of code, written from scratch. At the size yes charge. So like fuccaro keep asking for help, the more you learn the more help is normally offered.Lisp files Apr 2024.docx

Here is version for ellipse... (defun c:snakeoverellipse ( / *error* *adoc* el orth ell ce r1 r2 n c d p k p1 p2 pl bl ) (vl-load-com) (defun *error* ( m ) (if orth (setvar 'orthomode orth) ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq el (entlast)) (setq orth (getvar 'orthomode)) (setvar 'orthomode 1) (prompt "\nPick or specify point to create snake over ellipse - when draw mode of ELLIPSE firstly create X axis radius and then Y axis radius : ") (command "_.ELLIPSE" "_C") (while (< 0 (getvar 'cmdactive)) (command "\\") ) (if (not (eq el (entlast))) (progn (setq ell (entlast)) (setq ce (trans (cdr (assoc 10 (entget ell))) 0 1)) (setq r1 (abs (apply '+ (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))))) (setq r2 (* r1 (cdr (assoc 40 (entget ell))))) (initget 7) (setq n (getint "\nSpecify number of double turns : ")) (initget 1 "Yes No") (setq c (getkword "\nAdditional middle turn [Yes/No] : ")) (if (= c "Yes") (progn (if (equal (cadr (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))) 0.0 1e-8) (progn (setq d (/ (* 2 r2) (1+ (* 2 n)))) (setq p (list (+ (car ce) r1) (- (cadr ce) r2))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r2 2) (expt (- r2 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r2 2) (expt (/ d 2) 2))))) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (abs (- (car (polar ce (angle ce p) r1)) (car ce))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r2 2) (expt (* (+ k 0.5) d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r1) (+ (cadr ce) r2))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) (progn (setq d (/ (* 2 r1) (1+ (* 2 n)))) (setq p (list (+ (car ce) r2) (- (cadr ce) r1))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r1 2) (expt (- r1 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r1 2) (expt (/ d 2) 2))))) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (abs (- (car (polar ce (angle ce p) r2)) (car ce))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r1 2) (expt (* (+ k 0.5) d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r2) (+ (cadr ce) r1))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) ) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons -1.0 bl) (cons 1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) (progn (if (equal (cadr (trans (cdr (assoc 11 (entget ell))) 0 (cdr (assoc 210 (entget ell))))) 0.0 1e-8) (progn (setq d (/ r2 n)) (setq p (list (+ (car ce) r1) (- (cadr ce) r2))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r2 2) (expt (- r2 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r2) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r2 2) (expt (* k d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (abs (- (car (polar ce (angle ce p1) r1)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r1) (+ (cadr ce) r2))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) (progn (setq d (/ r1 n)) (setq p (list (+ (car ce) r2) (- (cadr ce) r1))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* (1+ k) d))) (* (1+ k) pi) (sqrt (- (expt r1 2) (expt (- r1 (* (1+ k) d)) 2))))) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r1) (* k d))) (* (1+ k) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r1 2) (expt (* k d) 2))))) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (abs (- (car (polar ce (angle ce p1) r2)) (car ce))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r2) (+ (cadr ce) r1))) (setq pl (cons p pl)) (setq pl (reverse pl)) ) ) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons 1.0 bl) (cons -1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pl)) (cons 70 (if (= (getvar 'plinegen) 1) 128 0)) (cons 38 (caddr (trans (cdr (assoc 10 (entget ell))) 0 (cdr (assoc 210 (entget ell)))))) ) (apply 'append (mapcar '(lambda ( a b ) (list (cons 10 (trans a 1 (cdr (assoc 210 (entget ell))))) (cons 42 b))) pl bl)) (list (assoc 210 (entget ell))) (list '(62 . 3)) ) ) ) ) (*error* nil) ) HTH, M.R.

Here is my version with bulges - arcs... (defun c:snakeovercircle ( / *error* *adoc* el ci ce r n c d p k p1 p2 pl bl ) (vl-load-com) (defun *error* ( m ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq el (entlast)) (prompt "\nPick or specify point to create snake over circle : ") (command "_.CIRCLE") (while (< 0 (getvar 'cmdactive)) (command "\\") ) (if (not (eq el (entlast))) (progn (setq ci (entlast)) (setq ce (cdr (assoc 10 (entget ci)))) (setq r (cdr (assoc 40 (entget ci)))) (initget 7) (setq n (getint "\nSpecify number of double turns : ")) (initget 1 "Yes No") (setq c (getkword "\nAdditional middle turn [Yes/No] : ")) (if (= c "Yes") (progn (setq d (/ (* 2 r) (1+ (* 2 n)))) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (polar (list (car ce) (cadr p2)) (if (= (rem n 2) 0) pi 0.0) (sqrt (- (expt r 2) (expt (/ d 2) 2))))) (setq pl (cons p pl)) (setq p (polar p (* 0.5 pi) d)) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d) (/ d 2))) (* (+ n k) pi) (sqrt (- (expt r 2) (expt (* (+ k 0.5) d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (+ (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons -1.0 bl) (cons 1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) (progn (setq d (/ r n)) (setq p (list (+ (car ce) r) (- (cadr ce) r))) (setq pl (cons p pl)) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (- (cadr ce) r) (* k d))) (* (1+ k) pi) (sqrt (- (expt r 2) (expt (- r (* (1+ k) d)) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq k -1) (repeat n (setq k (1+ k)) (setq p1 (polar (list (car ce) (+ (cadr ce) (* k d))) (* (+ n (1+ k)) pi) (sqrt (- (expt r 2) (expt (* k d) 2))))) (setq p2 (polar p1 (* 0.5 pi) d)) (setq pl (cons p1 pl) pl (cons p2 pl)) ) (setq p (list (- (car ce) r) (+ (cadr ce) r))) (setq pl (cons p pl)) (setq pl (reverse pl)) (setq bl (cons 0.0 bl)) (setq k -1) (repeat (- (length pl) 2) (setq k (1+ k)) (if (= (rem k 2) 0) (setq bl (cons 0.0 bl)) (setq bl (if (zerop (apply '+ bl)) (cons 1.0 bl) (cons -1.0 bl))) ) ) (setq bl (cons 0.0 bl)) ) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pl)) (cons 70 (if (= (getvar 'plinegen) 1) 128 0)) (cons 38 (caddr (cdr (assoc 10 (entget ci))))) ) (apply 'append (mapcar '(lambda ( a b ) (list (cons 10 a) (cons 42 b))) pl bl)) (list (assoc 210 (entget ci))) (list '(62 . 3)) ) ) ) ) (*error* nil) ) HTH, M.R.

One step? Hmmm....I'm not sure. None I can think of at the moment. I'll have to look into it. I'm glad to hear however that you did get the end result you were looking for.

Hi ReMark, I don't know if you remember me, but you were very helpful in my last Cad class. The result I want is what you showed, and I did get it using the slice command, but I was wondering if there was just a one step procedure using presspull, or something else. Maybe I could have gone about drawing the object differently to start, and then I wouldn't have this issue!

Is this the affect you're looking for? There is another way to do it too.

Press/Pull or Extrude and then use the Slice command might be one option.