Leaderboard

Pretty close .. here is the code if you want to study it. It's a quick mod of the code HERE. (defun c:foo (/ _dxf _sl _foo a b c e p s x) ;; RJP » 2019-01-10 (defun _foo nil (cond ((null (tblobjname "block" "triangle")) (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "triangle") (10 0. 0. 0.) (70 . 0) ) ) (entmake '((0 . "HATCH") (100 . "AcDbEntity") (8 . "0") (62 . 7) (420 . 16777215) (100 . "AcDbHatch") (10 0. 0. 0.) (210 0. 0. 1.) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 1) (92 . 1) (93 . 3) (72 . 1) (10 0.722608815692048 -0.0155020345055 0.) (11 0. 0.707106781186548 0.) (72 . 1) (10 0. 0.707106781186548 0.) (11 -0.722608815692047 -0.0155020345055 0.) (72 . 1) (10 -0.722608815692047 -0.0155020345055 0.) (11 0.722608815692048 -0.0155020345055 0.) (97 . 0) (75 . 1) (76 . 1) (98 . 1) (10 -32.1702098677918 -13.02209665774993 0.) (450 . 0) (451 . 0) (460 . 0.) (461 . 0.) (452 . 0) (462 . 0.) (453 . 2) (463 . 0.) (63 . 5) (421 . 255) (463 . 1.) (63 . 2) (421 . 16776960) (470 . "LINEAR") ) ) (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (62 . 0) (100 . "AcDbPolyline") (90 . 3) (70 . 128) (43 . 0.) (38 . 0.) (39 . 0.) (10 0.722608815692048 -0.0155020345055) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) (10 0. 0.707106781186548) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) (10 -0.722608815692047 -0.0155020345055) (40 . 0.) (41 . 0.) (42 . 0.) (91 . 0) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))) ) ) (princ) ) (_foo) (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))) (defun _dxf (c e) (cdr (assoc c (entget e)))) (cond ((setq s (_sl (ssget))) (foreach x s (if (wcmatch (_dxf 0 x) "CIRCLE,INSERT,POINT") (setq b (cons (_dxf 10 x) b)) (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x)))) (setq a (cons x a)) ) ) ) (and a b (foreach p b (setq c (mapcar '(lambda (x) (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x)) ) a ) ) (setq c (car (vl-sort c '(lambda (r j) (< (cadr r) (cadr j)))))) (if (not (equal 0 (cadr c) 1e-3)) (progn (setq e (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c)))) ) ;; This line below creates the right example comment out to get left ;; (setq a (cons e a)) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(67 . 0) '(8 . "Triangle") '(62 . 1) '(100 . "AcDbBlockReference") '(2 . "triangle") (cons 10 (car c)) ;; The block scale will need to be adjusted for your drawings ' (41 . 0.15) '(42 . 0.15) '(43 . 0.15) (cons 50 (+ (angle p (car c)) (/ pi 2))) ) ) ) ) ) ) ) ) (princ) )

If your going to make the circle then add it to the trim command. (command "TRIM" cir "" (nentselp p6) "") ;(command (nentselp p6)) not needed ;(command (nentselp p6)) not needed (entdel cir)

I am checked it and finally i found the error. This trim command sometimes exceeds its limit and cuts the line to the until other arc. I re-added the circle the trim command doesn't get the reference circle so it doesn't take like 1 or 2 mins. I tried code and %100 working now. ;;----------------------------------------------------------------------;; ;; CONNECT BLOCK TO LINE (defun C:FOO (/ r ss line p1 p2 p3 p4 brkpts) (or (setq r (vlax-ldata-get "radius" "R")) (C:SETUP)) ;thanks ronjonp (setq ss (ssget '((0 . "INSERT")))) (setq line (car (entsel "\nSelect Line: "))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq p1 (vlax-get (vlax-ename->vla-object ent) 'InsertionPoint)) (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) p1)) (setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) r)) (setq brkpts (cons p3 brkpts)) (setq p4 (polar p2 (- (angle p1 p2) (/ pi 2)) r)) (setq brkpts (cons p4 brkpts)) (setq p5 (polar p2 (+ (angle p1 p2) pi) r)) (entmake (list (cons 0 "LINE") (cons 10 p5) (cons 11 p1))) (entmake (list (cons 0 "ARC") (cons 10 p2) (cons 40 r) (cons 50 (angle p2 p3)) (cons 51 (angle p2 p4))))) (setq brkpts (vl-sort brkpts '(lambda (a b) (if (equal (car a) (car b) 1e-6) (> (cadr a) (cadr b)) (> (car a) (car b)) ) ) ) ) (setvar "cmdecho" 0) (command "_view" "_S" "Prebreak") ;save zoom location (repeat (/ (length brkpts) 2) (setq p6 (mapcar '/ (mapcar '+ (car brkpts) (cadr brkpts)) '(2 2 2))) (command "Zoom" "_w" (car brkpts) (cadr brkpts)) ;zoom to trim location (entmake (list (cons 0 "CIRCLE") (cons 10 p6) (cons 40 r))) (setq cir (entlast)) (command "TRIM" "" (nentselp p6)"") (entdel cir) (setq brkpts (cddr brkpts)) ) (command "_View" "_R" "Prebreak") ;load zoom location (princ) ) ;;----------------------------------------------------------------------;; ;; SETS R FOR FOO COMMAND (defun C:SETUP () (or (setq *r (vlax-ldata-get "Radius" "R")) (setq *r 0.500)) (if (setq r (getdist (strcat "\nSet Radius [" (rtos *r 2) "]: "))) (vlax-ldata-put "Radius" "R" r) (vlax-ldata-put "Radius" "R" (setq r *r)) ) )

I reckon that circle #1 is a wipeout boundary, and circle #2 is a circle.

@turbosocks Give this a try. (defun c:layerprefix (/ e el l f s tm) ;; RJP » 2022-08-12 (or (setq f (getenv "RJP_LayerPrefix")) (setq f (getenv "username"))) (cond ((and (setq f (cond ((/= "" (setq tm (getstring (strcat "\nEnter prefix [<" f ">]: ")))) tm) (f) ) ) (setq s (ssget ":L" (list '(-4 . "<NOT") (cons 8 (strcat f "*")) '(-4 . "NOT>")))) ) (setenv "RJP_LayerPrefix" f) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq el (entget (tblobjname "layer" (setq l (cdr (assoc 8 (entget e))))))) (or (tblobjname "layer" (setq nl (strcat f l))) (entmakex (subst (cons 2 nl) (assoc 2 el) el)) ) (entmod (subst (cons 8 nl) (assoc 8 (entget e)) (entget e))) ) ) ) (princ) )

;;----------------------------------------------------------------------;; ;; SPACE BLOCKS BY DISTANCE (defun c:dex (/ ss fblk dist pt1 line ang pt) (prompt "\nSelect Blocks to Align: ") (setq ss (ssget '((0 . "INSERT")))) (if (setq fblk (car (entsel "\nSelect First Block : "))) (ssdel fblk ss) ) (setq dist (getdist "\nSpacing Distance :")) (setq pt1 (cdr (assoc 10 (entget fblk)))) (setq ang (getangle "\nSpace Blocks on angle : ")) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ent (entget ent)) (setq pt (polar pt1 ang dist)) (entmod (subst (cons 10 pt) (assoc 10 ent) ent)) (setq pt1 pt) ) (princ) ) ;;----------------------------------------------------------------------;; ;; MOVE BLOCKS TO LINE (defun c:xs (/ SSBLK blk pt1 pt2) (princ "\nSelect Blocks : ") (setq SSBLK (ssget '((0 . "INSERT")))) (setq line (car (entsel "\nSelect Line : "))) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSBLK))) (setq pt1 (cdr (assoc 10 (setq ent (entget ent))))) (setq pt2 (vlax-curve-getclosestpointto (vlax-ename->vla-object line) pt1)) (entmod (subst (cons 10 pt2) (assoc 10 ent) ent)) ) (C:dex) (princ) ) --edit updated code if line wasn't horizontal dex wasn't correct

Check to see if you have limits on

Yea... this is actually a thing that I find annoying, and because I can't find any programs out there online to do this, I had to make one myself. You can still use the boundary command with the excess vertices being there. After that, call RXV and pass the polyline generated by the boundary command into the function. So for example, after you run (command "-boundary" pause), you can do (RXV (entlast)). ;; RXV --> Jonathan Handojo ;; Removes excess vertices in a 2D polyline curve. ;; ent - entity object of the 2D polyline to process. (defun RXV (ent / *error* a a1 a2 a3 b b1 b2 b3 bul c e e1 e2 e3 enx ewd i m1 p1 p2 p3 pm pmp pts rtn s1 s2 s3 sa ss swd v) (setq enx (entget ent) pts (vl-remove-if-not '(lambda (x) (= (car x) 10)) enx) swd (vl-remove-if-not '(lambda (x) (= (car x) 40)) enx) ewd (vl-remove-if-not '(lambda (x) (= (car x) 41)) enx) bul (vl-remove-if-not '(lambda (x) (= (car x) 42)) enx) pm -0.5 pmp (mapcar '(lambda (x) (setq pm (1+ pm))) pts) rtn (list (car pts) (car swd)) v -1 ) ;; Remove any vertex duplicates as they may interfere with calculations. (mapcar '(lambda (a b) (setq v (1+ v)) (if (equal (cdr a) (cdr b) 1e-8) (setq pts (RXV:RemoveNth v pts) swd (RXV:RemoveNth v swd) ewd (RXV:RemoveNth v ewd) bul (RXV:RemoveNth v bul) pmp (RXV:RemoveNth v pmp) v (1- v) ) ) ) pts (cdr pts) ) ;; Start calculations. (mapcar '(lambda (p1 s1 e1 b1 m1 p2 s2 e2 b2 m2 p3 s3 e3 b3 m3 / a1 a2 a3 c e p4 s4 e4 b4) (mapcar 'set '(p1 s1 e1 b1 p2 s2 e2 b2 p3 s3 e3 b3) (mapcar 'cdr (list p1 s1 e1 b1 p2 s2 e2 b2 p3 s3 e3 b3))) (if (not (setq e p3)) (setq p3 (cdar pts) p4 (cdadr pts) s4 (cdadr swd) e4 (cdadr pts) b4 (cdadr pts) ) ) (cond ( (and ;; If segment is straight (zerop b1) (zerop b2) ) (if (not (equal (RXV:vx1 (mapcar '- p1 p2)) (RXV:vx1 (mapcar '- p2 p3)) 1e-8)) (setq rtn (append rtn (list (cons 41 e1) '(42 . 0.0) '(91 . 0) (cons 10 p2) (cons 40 s2)))) ) (if (not e) (progn (setq rtn (append rtn (list (cons 41 e2) '(42 . 0.0) '(91 . 0)))) (if (equal (RXV:vx1 (mapcar '- p2 p3)) (RXV:vx1 (mapcar '- p3 p4)) 1e-8) (setq rtn (member (assoc 10 (cdr rtn)) rtn)) ) ) ) ) ( (and ;; If segment is curved (not (zerop b1)) (not (zerop b2)) ) (setq a1 (RXV:Bulge->Arc p1 p2 b1) a2 (RXV:Bulge->Arc p2 p3 b2) c (not (RXV:Clockwise-p p1 (vlax-curve-getpointatparam ent m1) p2)) ) (if (not (and (equal (car a1) (car a2) 1e-8) (equal (cadddr a1) (cadddr a2) 1e-8) ) ) (progn (if c (setq a3 (RXV:Arc->Bulge (car a1) (cond (sa) ((cadr a1))) (caddr a1) (cadddr a1)) rtn (append rtn (list (cons 41 e1) (cons 42 (cadr a3)) '(91 . 0) (cons 10 p2) (cons 40 s2))) sa nil ) (setq a3 (RXV:Arc->Bulge (car a1) (cadr a1) (cond (sa) ((caddr a1))) (cadddr a1)) rtn (append rtn (list (cons 41 e1) (cons 42 (- (cadr a3))) '(91 . 0) (cons 10 p2) (cons 40 s2))) sa nil ) ) (if (not e) (setq rtn (append rtn (list (cons 41 e2) (cons 42 b2) '(91 . 0))))) ) (progn (if (not sa) (if c (setq sa (cadr a1)) (setq sa (caddr a1)) ) ) (if (not e) (setq rtn (append rtn (list (cons 41 e2) (cons 42 (if (= (cdr (assoc 70 enx)) 1) (if c (cadr (RXV:Arc->Bulge (car a2) sa (caddr a2) (cadddr a2))) (- (cadr (RXV:Arc->Bulge (car a2) (cadr a2) sa (cadddr a2)))) ) b2 ) ) '(91 . 0) ) ) ) ) ) ) ) ( (and ;; If the previous segment is curved and is not collinear (not (zerop b1)) sa e ) (setq a1 (RXV:Bulge->Arc p1 p2 b1)) (if (not (RXV:Clockwise-p p1 (vlax-curve-getpointatparam ent m1) p2)) (setq a2 (RXV:Arc->Bulge (car a1) sa (caddr a1) (cadddr a1)) rtn (append rtn (list (cons 41 e1) (cons 42 (cadr a2)) '(91 . 0) (cons 10 p2) (cons 40 s2))) sa nil ) (setq a2 (RXV:Arc->Bulge (car a1) (cadr a1) sa (cadddr a1)) rtn (append rtn (list (cons 41 e1) (cons 42 (- (cadr a2))) '(91 . 0) (cons 10 p2) (cons 40 s2))) sa nil ) ) ) ( (setq rtn (append rtn (list (cons 41 e1) (cons 42 b1) '(91 . 0) (cons 10 p2) (cons 40 s2)))) (if (not e) (setq rtn (append rtn (list (cons 41 e2) (cons 42 b2) '(91 . 0))))) ) ) ) pts swd ewd bul pmp (cdr pts) (cdr swd) (cdr ewd) (cdr bul) (cdr pmp) (append (cddr pts) '(nil)) (append (cddr swd) (list (car swd))) (append (cddr ewd) (list (car ewd))) (append (cddr bul) (list (car bul))) (append (cddr pmp) (list (car pmp))) ) (entmod (append (vl-remove-if '(lambda (x) (member (car x) '(10 40 41 42 91))) enx) rtn ) ) ) (vl-load-com) ;; Bulge to Arc - Lee Mac ;; p1 - start vertex ;; p2 - end vertex ;; b - bulge ;; Returns: (<center> <start angle> <end angle> <radius>) (defun RXV:Bulge->Arc ( p1 p2 b / a c r ) (setq a (* 2 (atan b)) r (/ (distance p1 p2) 2 (sin a)) c (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r) ) (if (minusp b) (list c (angle c p2) (angle c p1) (abs r)) (list c (angle c p1) (angle c p2) (abs r)) ) ) ;; Arc to Bulge - Lee Mac ;; c - center ;; a1,a2 - start, end angle ;; r - radius ;; Returns: (<vertex> <bulge> <vertex>) (defun RXV:arc->bulge ( c a1 a2 r ) (list (polar c a1 r) ( (lambda ( a ) (/ (sin a) (cos a))) (/ (rem (+ pi pi (- a2 a1)) (+ pi pi)) 4.0) ) (polar c a2 r) ) ) ;; Clockwise-p - Lee Mac ;; Returns T if p1,p2,p3 are clockwise oriented (defun RXV:Clockwise-p ( p1 p2 p3 ) (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) ;; Unit Vector - Lee Mac ;; Args: v - vector in R^2 or R^3 (defun RXV:vx1 ( v ) ( (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n)))) (distance '(0.0 0.0 0.0) v) ) ) ;;----------------------=={ Remove Nth }==--------------------;; ;; ;; ;; Removes the item at the nth index in a supplied list ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; n - index of item to remove (zero based) ;; ;; l - list from which item is to be removed ;; ;;------------------------------------------------------------;; ;; Returns: List with item at index n removed ;; ;;------------------------------------------------------------;; (defun RXV:RemoveNth ( n l / i ) (setq i -1) (vl-remove-if '(lambda ( x ) (= (setq i (1+ i)) n)) l) )