Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/10/2023 in all areas

  1. Still a bit of a work in progress, but try this - it should work for polylines and lines but not a mix of the 2 yet. Got to add in remembering the last chamfer value (it defaults to 5 just now) (defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa) ;;https://forums.autodesk.com/t5/autocad-forum/break-at-point/td-p/7553581 (defun BAP ( entity point /) (setq entity (list entity point)) ; recreate entsel.... Added this line (command "_.break" entity "_F" "_non" point "_non" point) ) (defun MakeLine ( con10 con11 / ) (entmakex (append (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 10 con10) (cons 11 con11) )) ) ) ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-polyline-segment/td-p/1758253 (defun test ( msg / elst ename pt param preparam postparam) ; returns selected line coordinates (setq elst (entsel msg)) (if (= (cdr (assoc 0 (entget (car elst)))) "LINE") (progn (list (cdr (assoc 10 (entget (car elst))))(cdr (assoc 11 (entget (car elst)))) elst) ) ; end progn (progn (setq ename (car elst)) (setq pt (cadr elst)) (setq pt (vlax-curve-getClosestPointTo ename pt)) (setq param (vlax-curve-getParamAtPoint ename pt)) (setq preparam (fix param)) (setq postparam (1+ preparam)) (list (vlax-curve-getPointAtParam ename preparam) (vlax-curve-getPointAtParam ename postparam) elst ) ) ; end progn ) ; end if ) (defun trimlinetopt ( MyLine TrimPt1 TrimPt2 / MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPT MyLineA MyLineB) (command "zoom" "Object" MyLine "") (command "zoom" "0.95x") (setq MyLineDef (entget MyLine)) (setq MyLineEndA (cdr (assoc 10 MyLineDef))) (if (= (cdr (assoc 0 MyLineDef)) "LINE") (setq MyLineEndB (cdr (assoc 11 MyLineDef))) (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef)))) ) ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt1 "nea")) ) (setq Pt2Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt2 "nea")) ) (if ( > Pt1Dist Pt2Dist) (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn ) ;end if (BAP MyLine TrimPt1) (setq MyLineA (entlast)) (BAP MyLineA TrimPt2) (setq MyLineB (entlast)) (entdel MyLineA) (command "zoom" "Previous") (command "zoom" "Previous") MyLineA ) ;; add here something nice like "select lines or [option]" ;; Also add here something nice to remember value from last time (setq chdist 5) (setq chdist (getreal (strcat "Enter Chamfer Distance: " (rtos chdist)))) (if (or (= chdist 0)(= chdist nil))(setq chdist 5)) (setq coords1 (test "\nSelect Line or segment 1: ")) (setq pline1 (car (last coords1))) (cond ( (= (cdr (assoc 0 (entget pline1))) "LINE") (setq MyType "Line") (setq chdisttemp 0) (command "chamfer" (cadr (last coords1)) "Distance" chdisttemp chdisttemp (setq pt (getpoint)) ) (setq pline2 (nentselp pt)) (setq NL1 (makeline (car coords1)(cadr coords1)) ) (setq NL2 (makeline (cdr (assoc 10 (entget (car pline2)))) (cdr (assoc 11 (entget (car pline2)))) )) ) ((= (cdr (assoc 0 (entget pline1))) "LWPOLYLINE") (setq MyType "Polyline") (setq coords2 (test "\nSelect Line or segment 2: ")) (setq pline2 (car (last coords2))) (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1 (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2 ) (t (princ "Can't do a mix of lines... just now") (setq MyType "Mix") ) ) ; end conds (command "chamfer" NL1 "Distance" chdist chdist NL2) (setq NL3 (entlast)) (setq NL3PtA (cdr (assoc 10 (entget NL3))) ) (setq NL3PtB (cdr (assoc 11 (entget NL3))) ) (command "move" NL1 "" NL3PtA NL3PtB ) (command "move" NL2 "" NL3PtB NL3PtA ) (cond ((= MyType "Line") (command "extend" NL1 NL2 "" NL1 NL2 "") (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) ) (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int))) (entdel NL1) (entdel NL2) (setq NL1 (makeline ptsa NL3PtA) ); templine 3 (setq NL2 (makeline ptsa NL3PtB) ); templine 4 (entdel NL3) (command "chamfer" NL1 "Distance" chdisttemp chdisttemp pline1) (command "chamfer" NL2 "Distance" chdisttemp chdisttemp pline2) ) ((= MyType "Polyline") (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) ) (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int))) (entdel NL1) (entdel NL2) (setq NL1 (makeline ptsa NL3PtA) ); templine 3 (setq NL2 (makeline ptsa NL3PtB) ); templine 4 (entdel NL3) (trimlinetopt pline1 NL3PtA NL3PtB) (command "join" pline1 (entlast) NL1 NL2 "") ) ) ; end conds (princ) )
    3 points
  2. Welcome to the forum .. give this a whirl. (defun c:layoutstodwgs (/ *error* _undobegin _undoend parsestring _dir dir doc layouts msg pre suf vars x) ;; RJP » 2016-02-15 (defun *error* (msg) ;; Reset variables on error (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (defun _undobegin (doc) (_undoend doc) (vla-startundomark doc)) (defun _undoend (doc) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc))) (setq layouts (vla-get-layouts (setq doc (vla-get-activedocument (vlax-get-acad-object)))) pre (getstring "\nEnter filename PREfix: ") suf (getstring "\nEnter filename SUFfix: ") dir (getvar 'dwgprefix) msg "" vars (mapcar '(lambda (x) (cons x (getvar x))) '("filedia" "expert" "tilemode" "cmdecho")) ) (mapcar '(lambda (a b) (setvar (car a) b)) vars '(0 5 1 0)) (command "_ucs" "_w") (foreach l (layoutlist) (setvar 'ctab l) (if (> (sslength (ssget "_X" (list (cons 410 l)))) 1) (progn (_undobegin doc) ;; Check if there are viewports .. if not delete modelspace objects to keep file size down (if (= 1 (sslength (ssget "_x" (list (cons 0 "VIEWPORT") (cons 410 l))))) (progn (mapcar 'entdel (mapcar 'cadr (ssnamex (ssget "_x" '((410 . "Model")))))) (setq msg (strcat l " has 0 viewports. Modelspace items removed..." "\n" msg)) ) ) ;; Remove all layout tabs except current (vlax-for x layouts (if (/= (getvar 'ctab) (vla-get-name x)) (vl-catch-all-apply 'vla-delete (list x)) ) ) ;; Wblock current layout (command "_-wblock" (strcat dir pre l suf) "*") (setq msg (strcat dir pre l suf ".dwg created.\n" msg)) ;; Undo end (_undoend doc) ;; Undo all the tabs deleted (command "_u") ) (setq msg (strcat l " has nothing on it and skipped." "\n" msg)) ) ) (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars) (princ msg) (princ) )
    1 point
  3. The best way to fix a gap is not to draw it in the first place. Is it possible to draw a polyline to represent your polygon? That way the nodes are guaranteed to close, especially if you use the Close option to finish it.
    1 point
  4. I'm guessing there probably is a way. On the other hand, what leads to the gaps? Are you drawing just by trying to place the end of a new PLINE at the end of another one "by eye"? Are you using the Snaps so that the next PLINE you draw is geometrically starting from teh exact endpoint of the previous PLINE?
    1 point
  5. After digging into this more. I found out that you can not remove "all" the tool palette paths from the options. If you do, it will automatically set it back to the default path. To get this to "kind of" work, I had to use the following from Ronjons code. With the example below, when the user clicks the button in the ribbon, it would load the tool palette for (path2) by removing (path1), within the tool palette, I have a button towards the bottom which would load (path1) back in and unload the (path2). (defun _addtoolpalettepaths (paths / a b) (setq b (getvar (setq a "*_toolpalettepath"))) (setvar a (strcat b (apply 'strcat (mapcar '(lambda (x) (if (vl-string-search (strcase x) (strcase b)) "" (strcat ";" x) ) ) paths ) ) ) ) ) ;; usage (_addtoolpalettepaths '("c:\\path1" "d:\\path2")) https://www.cadtutor.net/forum/topic/69163-tool-palette-support-path-lisp/ If a user has several toolpatettepaths, can i save all those paths, then unload them, to load (path2), then when they are done with the tool, it would load their several paths back?
    1 point
  6. Quick answer is just that ANS is the variable that holds the string returned when you select a button. Sometimes you want a different answer to the please choose string, so you can alos use BUT it is the number of the button selected so you can use it with a cond and set a variable to a different value than shown. (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= ahdef nil)(setq ahdef 1)) (setq ans (ah:butts ahdef "V" '("Choose type" "USB" "WALL" "FENCE" "CEILING" "WINDOW" "DOOR" "7" "8" "9" "10"))) (setq ahdef but) This will set the default button to the last picked so just press ok say wall, wall, wall. Makes easier to repeat. (princ ans) = "WINDOW" Ok part 2 use Multi getvals.lsp to pop a dcl and enter distance. OK part 3 as suggested redo the dcl so includes the distance. Ok start by changing this line and run once. It will write all the dcl code for you for the multi radio. (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (setq fo (open (setq fname "D:\\acadtemp\\temp.dcl") "w")) ; change output directory to one you have. You need to edit this dcl "temp" to add the extra column of getval. If you don't know how post. Last comment I found a convert DCL to lisp so once you get the dcl working can add it to the lisp code so no need for the DCL file. Multi GETVALS.lsp
    1 point
  7. At a glance looks like something got uncommitted maybe and the naming convention makes me think this came from ChatGPT? --Edit This code is a HOT MESS ssget doesn't need error handling. it either finds something or it doesn't. wont throw an error if it doesn't find anything. Also why are you making a selection set of the block you want to insert? (tblsearch "BLOCK" "blockname") would let you know if its in the drawing. block_name is set after the if statement checking for it. and will be reset after lisp is "done" running so "true" side of this if will never run. the true side of the if statement immediately overwrites the block_name so if it was set its always going to be "coor" (command "rotate" (entlast) "" target_block_insert_point) stops just shy of a complete command (missing the rotation angle) this would leave and open command in the prompt. so when scale is inputted it will error the vla-insertblock will never work since block_name, block_scale, and block_rotate will never set since the if statement will always be false. (all are set on the side of true) It got the start and end undo points right tho! You would be better off telling us what you want to do or even better yet upload a sample drawing. so we can start from scratch.
    1 point
  8. So you made lots of circles offset and trimmed. If you want each shape to be individual change to another layer and use BPOLY command this will make new plines as a shape representing the 2 arcs but with ends. Just pick a point inside the 2 arcs.
    1 point
  9. Is it annotative text? If the viewport scale doesn't match the text's annotative scale, you won't see it.
    1 point
  10. (defun c:blitzH (/ adoc) (vlax-for blk (vla-get-blocks (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) [color="blue"] (if [/color](eq :vlax-false (vla-get-isXref blk)) (vlax-for h blk (if (and (vlax-write-enabled-p h) (eq (vla-get-ObjectName h) "AcDbPoint") ) (vla-delete h) ) ) [b][color="blue"] )[/color][/b] ) (vla-regen aDoc acAllViewports) ) But of course, there are other factors to consider like locked layer and some
    1 point
×
×
  • Create New...