Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/18/2023 in all areas

  1. Ok 2d and 3d poly co-ordinates sample code. ; pline co-ords example ; By Alan H (defun getcoords (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) "Coordinates" ) ) ) ) ; convert now to xyz (defun co-ords2xy (xyz / ) (setq co-ordsxy '()) (if (= xyz 2) (progn (setq I 0) (repeat (/ (length co-ords) 2) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 2)) ) ) ) (if (= xyz 3) (progn (setq I 0) (repeat (/ (length co-ords) 3) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 3)) ) ) ) ) (defun c:wow ( / ) (setq obj (vlax-ename->vla-object (car (entsel "Pick obj")))) (setq co-ords (vlax-get obj 'coordinates)) (cond (( = (vla-get-objectname obj) "AcDb2dPolyline")(co-ords2xy 2)) (( = (vla-get-objectname obj) "AcDb3dPolyline")(co-ords2xy 3)) ) (princ co-ordsxy) (foreach pt co-ordsxy (setq pt (list (car pt)(cadr pt) (caddr pt))) (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2)) ) (princ) ) (c:wow)
    2 points
  2. (command "chprop" (ssget "_:L-I") "" "COLOR" "t" "255,51,204" "") (Crayola Razzle Dazzle Rose colour....) and I don't care,. this is the lisp name, like it or not,. (defun c:Lauper ( / ) ; True colours. (setq MyEnt (car (entsel))) (setq MyObj (vlax-ename->vla-object MyEnt)) ;;https://adndevblog.typepad.com/autocad/2012/12/accessing-the-truecolor-property-using-visual-lisp.html (setq oColor (vlax-get-property MyObj 'TrueColor) clrR (vlax-get-property oColor 'Red) clrG (vlax-get-property oColor 'Green) clrB (vlax-get-property oColor 'Blue) ) ;;Match colour (princ "Thanks, select objects to change") (command "chprop" (ssget "_:L-I") "" "COLOR" "t" (strcat (rtos clrR) "," (rtos clrG) "," (rtos clrB)) "") )
    2 points
  3. Never even thought of colour book @ronjonp. Thanks. This is proving a very handy tool. Ps. I do like the name @Steven P.
    1 point
  4. Give this a try. It will match INDEX, RGB and COLORBOOK as well as match the LAYER NAME. It has the added benefit of also leaving bylayer colors intact. (defun c:foo (/ f h o s sp) ;; RJP » 2023-05-18 (cond ((setq s (ssget '((0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")))) (setq sp (vlax-ename->vla-object (cdr (assoc 330 (reverse (entget (ssname s 0))))))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (cond ((vlax-curve-isclosed e) (setq h (vlax-invoke sp 'addhatch achatchobject "SOLID" :vlax-true)) (vlax-invoke h 'appendouterloop (list (vlax-ename->vla-object e))) (setq f (vl-remove-if-not '(lambda (x) (member (car x) '(8 62 420 430))) (entget e))) ;; Match layer and byobject colors (entmod (append (entget (vlax-vla-object->ename h)) f)) (vla-evaluate h) ) ) ) ) ) (princ) )
    1 point
  5. When I say simple, I mean the font used. If everything is horizontal and pretty much all simplex, that would be an easy conversion to run a script in batch of drawings. One other thing, you might try this VectPDF download | SourceForge.net I used it prior to AutoCAD having the import PDF function. Not sure if it has had any updates in a while. As for SHX fonts, you can make them comments when plotted to PDF. Acrobat can plot them as searchable with PDFMaker. (I am not sure how that comes back into AutoCAD, though.) True Type Fonts can also be made non-searchable, so not foolproof either. (I am not sure how that comes back into AutoCAD, either.) How to create selectable and searchable text in a PDF from AutoCAD (autodesk.com) Unfortunately, OCR has been used a lot more for creating image text to editable text, much more development in that area I would surmise, I had some very good OCR software that came with a scanner way back in the 80s. I have found very little on batch converting, either in AutoCAD, Adobe or others. Acrobat may be able to batch convert, I am not sure on that. I would just suggest pick a method and get to work on them manually.
    1 point
  6. Lunchtime here in a few minutes I'll look after then - but they way we're going you'll be off and finished this soon yourself
    1 point
  7. Right so this how far I got but something isn't correct what did I do wrong here? Posting this even though it is wrong because I need to know why it is wrong not because I haven't put in the effort to fix it. (defun c:checkdistance (/ Mypoly MyPolyVertexes ) (if (setq MyPoly (ssname (ssget "_+.:E:S" '((0 . "*POLYLINE"))) 0 )) (progn (setq MyPoly (entget (ssname Mypoly 0))) (foreach sublist Mypoly (if (= (car sublist) '10) (setq MyPolyVertexes (append MyPolyVertexes (list (cdr sublist)))))) (princ (entget MyPolyVertexes))) (princ "No polyline found in the drawing.")) (princ) ) Thank you @BIGAL I look forward to implementing that into the code. Many thanks to you as well @Steven P
    1 point
  8. Try this still thinking about an auto angle approach. Make sure Multi Radio buttons.lsp is saved in a support path directory.Multi radio buttons.lsp ; https://www.cadtutor.net/forum/topic/77391-how-can-i-modify-this-code-to-allow-me-to-select-a-base-point-as-basis/ ; Dimensions a shape with a 200 offset for 4 sides Right Left Top Bottom. ; By AlanH May 2023 (defun c:dim200 ( / dr200 dl200 db200 dt200 lst ans) (defun dr200 ( / pt1 pt2 x lst2 j pt3) (setq lst2 '()) (foreach pt lst (setq lst2 (cons (cadr pt) lst2)) ) (setq X (car (vl-sort lst2 '>))) (setq pt3 (list (+ x 200.) (cadr (car lst)))) (setq x (length lst)) (setq j 0) (setvar 'osmode 0) (repeat (- x 1) (command "dim" "ver" (nth j lst) (nth (1+ j) lst) pt3 "" "exit") (setq j (1+ j)) ) (setvar 'osmode oldsnap) (princ) ) (defun dl200 ( / pt1 pt2 x lst2 j pt3) (setq lst2 '()) (foreach pt lst (setq lst2 (cons (car pt) lst2)) ) (setq X (car (vl-sort lst2 '<))) (setq pt3 (list (- x 200.) (cadr (car lst)))) (setq x (length lst)) (setq j 0) (setvar 'osmode 0) (repeat (- x 1) (command "dim" "ver" (nth j lst) (nth (1+ j) lst) pt3 "" "exit") (setq j (1+ j)) ) (setvar 'osmode oldsnap) (princ) ) (defun dt200 ( / pt1 pt2 y lst2 j pt3) (setq lst2 '()) (foreach pt lst (setq lst2 (cons (cadr pt) lst2)) ) (setq Y (car (vl-sort lst2 '>))) (setq pt3 (list (car (car lst)) (+ y 200.) )) (setq x (length lst)) (setq j 0) (setvar 'osmode 0) (repeat (- x 1) (command "dim" "hor" (nth j lst) (nth (1+ j) lst) pt3 "" "exit") (setq j (1+ j)) ) (setvar 'osmode oldsnap) (princ) ) (defun db200 ( / pt1 pt2 y lst2 j pt3) (setq lst2 '()) (foreach pt lst (setq lst2 (cons (cadr pt) lst2)) ) (setq Y (car (vl-sort lst2 '<))) (setq pt3 (list (car (car lst)) (- y 200.) )) (setq x (length lst)) (setq j 0) (setvar 'osmode 0) (repeat (- x 1) (command "dim" "hor" (nth j lst) (nth (1+ j) lst) pt3 "" "exit") (setq j (1+ j)) ) (setvar 'osmode oldsnap) (princ) ) ;;;;;;; starts here (setq oldsnap (getvar 'osmode)) (setq lst '()) (while (setq pt1 (getpoint "\nPick dim point in sequence Enter to stop ")) (setq lst (cons pt1 lst)) ) (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (setq ans (ah:butts 1 "V" '("Choose a side" "Right" "Left" "Top" "Bottom"))) (cond ((= ans "Right")(dr200)) ((= ans "Left")(dl200)) ((= ans "Top")(dt200)) ((= ans "Bottom")(db200)) ) (setvar 'osmode oldsnap) (princ) )
    1 point
  9. and another way: (DEFUN C:SD ( / ) (setq P1 (GETPOINT "\n Pick Start Point :") ) (setq P2 (GETPOINT P1 "\n Pick End Point :") ) (setq EV (GETREAL "\n Enter Distance :") ) (setq XY (mapcar '+ (list EV 0 0) P1)) (COMMAND "POINT" P1) ; POINT P1 (COMMAND "POINT" P2) ; POINT P2 (COMMAND "POINT" XY) ; NEW POINT FROM P1 X - AXIS VALUE FOR EV DISTANCE (PRINT XY) ) EDITED CODE SLIGHTLY
    1 point
  10. Try this: (defun c:foo (/ str) (if (= 3 (strlen (setq str (getstring "\Enter new 3 digit suffix")))) (vlax-for l (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (vl-catch-all-apply 'vla-put-name (list l (strcat (substr (vla-get-name l) 1 5) str))) ) (print "Input is invalid!") ) (princ) )
    1 point
  11. There is no way to request a DWG, and yes, often the creator does not want his drawings to be used by others...
    1 point
  12. @CANDOWE ;just for one (SETQ ENT (CAR (ENTSEL "pick ent"))) (REDRAW ENT 3) ; for a few (SETQ SS-ENT (SSGET))
    1 point
×
×
  • Create New...