Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/04/2022 in all areas

  1. But here is a great place to learn a bit more about it
    3 points
  2. You understand that (setq myblockcolour 10) is red and want to change it to Byblock? lisp typically only use numbers for colors. You can see all the different colors #'s use this. (acad_colordlg 1) Their are also 7 colors you can call by their name like red, yellow, green, cyan, blue, magenta, white @BIGAL is giving you the answer. (setq myblockcolour 0) ;= Byblock (setq myblockcolour 256) ;= Bylayer (setq myblockcolour (acad_colordlg 1)) ;user can pick the color each time the lisp is ran
    3 points
  3. This will return the entity list from the second one on: (member (assoc 100 (cdr (member (assoc 100 ent) ent))) ent) You could save and repeat until none remain.
    2 points
  4. You could try this: "attred" and will set the block objects to colour "10" (red), however it won't change any nested blocks definitions, just change their colour (so if that nested block is drawn using Green lines it will show as green, if it is drawn using "ByBlock" coloured lines it will show as red (or whatever colour you set this to be) Please note that I copied and pasted a lot of this but I didn't note where I took the original parts from, if the originator reads this, thanks I use this all the time, but let me know so I can credit you accordingly. (defun c:attred (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) (setq myblocklayer "0") (setq myblockcolour 10) (setq myblocklineweight aclnwtbyblock) (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) (defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Sets the block attributes ;;add in here other attributes to change (vla-put-layer ent myblocklayer) (vla-put-color ent myblockcolour) (vla-put-lineweight ent myblocklineweight) ;; (vla-put-linetype ent myblocklinetype) ;;end of setting up block attributes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) ) ;_ end of defun
    2 points
  5. ancient history for extra credit https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/massoc-cdrs-amp-c/td-p/841943
    1 point
  6. Another one commonly used to pull point lists .. modified for 100 code: (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 100 (car x))) elist))
    1 point
  7. Basically the same thing just condensed down a little more. ;(cdrs 10 (entget (car (entsel "\nSelect a polyline: ")))) ;returns something like this: ;((259.943 -252.219) (214.182 -140.305) (254.223 -92.925) (215.0 -21.0386) ; (253.406 41.8621) (215.817 112.115)) ;Michal Puckett (defun cdrs (key lst / pair rtn) (while (setq pair (assoc key lst)) (setq rtn (cons (cdr pair) rtn) lst (cdr (member pair lst)) ) ) (reverse rtn) )
    1 point
  8. Here is my utility function for multiple associations, credit Tony Tanzillo 1999. ;;;========================================================================= ;;; massoc ;;; ;;; get multiple items from an association list (instead of just 1st one) ;;; ;;; From: Tony Tanzillo (tony.tanzillo@worldnet.att.net) ;;; Subject: Re: extracting multiple assoc from list ;;; Newsgroups: autodesk.autocad.customization ;;; Date: 1999/09/29 ;;; ;;; revised by Dan, 2017 ;;; to add option for key to be a list of assoc codes, '(10 11), or just a single ;;;========================================================================= (defun massoc (key alist / x nlist) (if (not (= 'LIST (type key))) (setq key (list key)) ) (foreach y key (foreach x alist (if (eq y (car x)) (setq nlist (cons (cdr x) nlist)) ) ) ) (reverse nlist) ) ;end defun
    1 point
  9. Try this, you should not check for 90 as this is for concrete slabs a architect may have a slab with a angle. Also the bar angle should be a true 90 from the internal corner angle. See images. (defun C:ABAR (/ ) (command "._undo" "_begin") (setq sv_lst (list 'osmode 'cmdecho) sv_vals (mapcar 'getvar sv_lst) blk "rebar" ) (command "-layer" "m" "tempAB" "Color" "cyan" "" "Plot" "Plot" "" "Ltype" "continuous" "" "") (if (setq ss (ssget "_:L" '((0 . "*POLYLINE") ) )) (repeat (setq n (sslength ss)); repeat each edge (command "_.COPY" (ssname ss (setq n (1- n))) "" "0,0" "0,0") (command "_.chprop" "L" "" "LA" "tempAB" "") (command "_.explode" "L") (setq firstRun 0) ;;-+-----repeat each line of the edge ;;;line segment iteration------------------------------------------------------------------------------------ (repeat (setq m (sslength (setq sss (ssget "_P")))) (setq ent (ssname sss (setq m (1- m))) ppt1 (vlax-curve-getStartPoint ent) ppt2 (vlax-curve-getEndPoint ent) );end_setq (if (= firstRun 0) (progn (setq firstRun 1) (setq ent2 (ssname sss (- m 1))) (setq ppt3 (vlax-curve-getEndPoint ent2)) (Insert90 ppt1 ppt2 ppt3) ) (progn (setq ent2 (ssname sss (+ m 1))) (setq ppt3 (vlax-curve-getEndPoint ent2)) (Insert90 ppt1 ppt2 ppt3) ) ) ;; dont erase, for testing. ;;(command "erase" ent "") ) ); repeat each edge ; repeat each line in exploded selection set-------------------------------------------------------------------------------- ); if (command "-purge" "la" "tempAB" "n") (command "._undo" "_end") (princ) ); defun ;; Convert Radians to Degrees (defun rtod (r) (* 180.0 (/ r pi))) ;;figure out where the pt lies (defun lm:getinsideangle (p1 p2 p3) ((lambda (a) (min a (- (+ pi pi) a))) (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)) ) ) ;;D. C. Broad, Jr. ;;(sideof <ray-origin> <another-point-on-ray> <point-to-be-tested>) (defun sideof (p1 p2 p / r) (setq r (cond ((equal p1 p 1e-10) 0) (t (sin (- (angle p1 p) (angle p1 p2)))) ) ) (if (equal r 0 1e-10) 0 r) ) (defun Insert90 (pt1 pt2 pt3) (setq BlkName "rebar") ;;return values ;;negative = point is to the right side of the ray ;;0 = point is on the ray ;;otherwise point is on the left side of the ray. ;;P1 should not equal P2 for meaningful results. (setq p1 pt1) (setq p2 pt2) (setq p3 pt3) (setq lr (sideof pt1 pt2 pt3)) (princ lr) (princ "\n") (if (> lr 0.0) (command "-insert" BlkName "_non" pt2 1 "" (rtod (angle pt2 pt1))) ) (princ) ) (c:abar) Version 2 having a think working out your code.
    1 point
  10. If you are going to be doing this regularly, or have a lot to do, then I suggest that you purchase a conversion utility. I always used to use PDF Fly, it's not free but it always did very good vector PDF to DWG/DXF conversion with very little clean up needed following the conversion. It would also import raster PDFs as images into Autocad. https://visual-integrity.com/products/pdf-fly-pdf-conversion-suite/ There is a service where you can get one free conversion per week to see what their conversion products can do for you: https://convertpdf.today/
    1 point
×
×
  • Create New...