Jump to content

Leaderboard

Popular Content

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

  1. That's a point, forgot if you want to exit (I tend to hit escape a few times to cancel a command, tend to forget about enter and space a little)
    1 point
  2. @Steven P That works, but the only drawback is you are stuck in the while loop if you just want to just press ENTER to exit the selection, without selecting something. You would have to select something or hit ESC to cancel out.
    1 point
  3. Here is another way, slight difference in selecting the boundary and blatant copy of pkenewell error. Using ssget "+.:E:S" in case you later want to add more filters than just a polyline. Put the units type (-units command) as a variable to reset it after the LISP has run Moved the end of an if statement (if POLY) to the end so that if no polyline is selected the LISP will just stop. (defun C:BS ( / clayer vars old MySS Poly SS obj cc d i s ) (vl-load-com) (defun trap (msg) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*")) (princ (strcat "\nError: " msg "\n")) (princ "\nProgram Aborted.\n") ) (if (and vars vals)(mapcar '(lambda (x y) (setvar x y)) vars vals)) (setq *error* temperr) (vl-cmdf "._undo" "_end") (princ) ) ; end defun ;; https://www.afralisp.net/visual-lisp/tutorials/error-trapping.php (setq temperr *error*) (setq *error* trap) (vl-cmdf "._undo" "_begin") ;;Start Undo (setq clayer (getvar "clayer")) ;;Get current Layer (setq vars '("CMDECHO" "DIMLFAC" "DIMLUNIT" "DIMDEC" "DIMTXT" "LUNITS")) (setq old (mapcar 'getvar vars)) ;;get old variables (mapcar 'setvar vars '(0 1 4 4 0.5 4)) ;;set variables above according to list values ;; (setvar "cmdecho" 0) ; see above ;; (setvar "dimlfac" 1) ; see above ;; (setvar "dimlunit" 4); see above ;; (setvar "dimdec" 4) ; see above ;; (setvar "dimtxt" 0.5); see above ;; (vl-cmdf "-UNITS" 4 "" "" "" "" "") ; see above (vl-cmdf "_.ZOOM" "E" "_.zoom" ".9x") (vl-cmdf "-overkill" "all" "" "P" "N" "") (initcommandversion)(command "_.join" "_All" "") (while (= (setq MySS (ssget "_+.:E:S" (list (cons 0 "*POLYLINE")) )) nil) (princ "\nOh No!! that is not a polyline") ) ; end while ;; (if (setq Poly (car (entsel "\nSelect Boundary: "))) (if (setq Poly (ssname MySS 0)) (progn (vl-cmdf "-Layer" "M" "PIECE" "C" "40" "" "") (vla-put-layer (vlax-ename->vla-object Poly) "PIECE") (vla-put-color (vlax-ename->vla-object Poly) 256) ;; ) ; end progn ; moved to end of LISP ;; ) ; end if ; moved to end of LISP (setvar "clayer" clayer) (vl-cmdf "_.layer" "F" "PIECE" "") (if (setq SS (ssget "_A" (LIST '(0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC")))) (progn (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "") (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))) (vla-put-layer obj "HOLE") (vla-put-color obj 256) ) ; end foreach ) ; end prog ) ; end if (vla-Explode (vlax-ename->vla-object Poly)) (vla-Delete (vlax-ename->vla-object Poly)) (if (setq cc (ssget "_A" (LIST '(0 . "CIRCLE") '(40 . 0.0)))) (progn (setq d 0.5) ; default circle radius ;; (and (setq d 1.00) ;; (setq d (/ d 2.)) ;; ) ; end and (repeat (setq i (sslength cc)) (setpropertyvalue (ssname cc (setq i (1- i))) "Radius" d) ) ; end repeat (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex cc)))) (vl-cmdf "-Layer" "M" "ERROR" "C" "1" "" "") (vla-put-layer obj "ERROR") (vla-put-color obj 256) ) ; end foreach ) ; end progn ) ; end if (and (setq s (ssget "_X" '((0 . "POINT,TEXT")))) (vl-cmdf "_.erase" s "") ) ; end and (vl-cmdf "-purge" "a" "" "n") (vl-cmdf "-Layer" "M" "MARKER" "C" "240" "" "") (vl-cmdf "-Layer" "T" "PIECE" "") (vl-cmdf "-Layer" "U" "HOLE" "") (vl-cmdf "-Layer" "M" "HOLE" "C" "140" "" "") (vl-cmdf "-Layer" "M" "0" "C" "7" "" "") ) ; end progn (progn (princ "\nNo suitable polyline selected") ) ) ; end if Poly exists (setvar "cmdecho" 1) (vl-cmdf "._undo" "_end") (mapcar 'setvar vars old) (princ) )
    1 point
  4. PKENEWELL, That work perfect!!!! Thank you so much. Brian
    1 point
  5. I didn't mean to sound like I was rushing you. I'm just frustrated that I can't figure it out on my own.
    1 point
  6. Thanks Emmanuel Delay. Your Lisp works exactly as I wanted.
    1 point
  7. Like this? (defun c:ccd (/ gtt dt sdt ent id str) (setq dt (ssget '((0 . "DIMENSION"))) sdt (sslength dt) id 0 gtt 0 str "=" ) (repeat sdt (setq ent (ssname dt id) id (1+ id) gtt (+ gtt (gt1 ent) ) str (strcat str (Rtos (gt1 ent) 2 0 ) "+") ) ) (Lisped (substr str 1 (1- (strlen str)))) (princ gtt) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gt1 (ent / so ro) ;; roundoff (setq ro (nth 0 (ParseIt (cdr (assoc 3 (entget ent)))))) (if (wcmatch (cdr (assoc 1 (entget ent))) "") (setq so (LM:roundm (cdr (assoc 42 (entget ent))) ro)) ;; round the value to ro (setq so (atof (cdr (assoc 1 (entget ent))))) ) ) ;; http://www.lee-mac.com/round.html ;; Round Multiple - Lee Mac ;; Rounds 'n' to the nearest multiple of 'm' (defun LM:roundm ( n m ) (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/extracting-numeric-values-on-a-string/td-p/784014 (defun ParseIt (str) (read (vl-list->string (append '(40) ; "(". (mapcar '(lambda (int) (if (or (= 46 int) (<= 48 int 57)) int 32)) (vl-string->list str) ) '(41) ; ")". ) ) ) )
    1 point
  8. I think if you remove the 430 out of this list you should be good to go. '(62 420 430)
    1 point
×
×
  • Create New...