Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/30/2022 in all areas

  1. Column version (defun c:foo (/ n) (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHbutts : dialog {" fo) (write-line " label =\"Choose revision\" ;" fo) (write-line " : row{" fo) (write-line " : boxed_radio_column {" fo)
    3 points
  2. I don't have anything to test with not sure about (or but should work. (defun c:foo (/ n) ; (or (setq n (getint "\nEnter percent:<30>")) (setq n 30)) (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (or (setq n (atoi (ah:butts 1 "h" '("Choose revision" "30%" "60%" "90%")))) ; n holds the button picked value Multi radio buttons.lsp
    3 points
  3. I think it's because people don't use this method because it's too slow. I edited the gif to save your time. ; CTEXT & PTEXT - 2022.06.30 exceed ; step 1 - use CTEXT, copy all text's handle & textstring to excel (except locked or freezed) ; step 2 - edit in excel C column. ; step 3 - place your cursor in that table, press ctrl+a > ctrl+c ; step 4 - in CAD, press PTEXT to put your new text strings in there (vl-load-com) (defun c:CTEXT ( / *error* ss ssl index textlist obj hand textlayer textlayerobj layerlocked layerfreezed tstring indexr textlista indexc putstring xlcolumns ) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (ex:RELEASEEXCELforctcs) (princ) ) (setq ss (ssget "X" '((0 . "*text")))) (setq ssl (sslength ss)) (setq index 0) (setq textlist '()) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq hand (vlax-get-property obj 'handle)) (setq textlayer (vlax-get-property obj 'layer)) (setq textlayerobj (vlax-ename->vla-object (tblobjname "layer" textlayer))) (setq layerlocked (vlax-get-property textlayerobj 'lock)) (setq layerfreezed (vlax-get-property textlayerobj 'freeze)) (if (and (= layerlocked :vlax-false) (= layerfreezed :vlax-false)) (progn (setq tstring (vlax-get-property obj 'textstring)) (setq textlist (cons (list hand tstring) textlist)) ) (progn ;(princ "\n it's locked or freezed") ) ) (setq index (+ index 1)) ) (ex:ESMAKE) (setq indexr 0) (repeat (length textlist) (setq textlista (nth indexr textlist)) (setq indexc 0) (repeat (length textlista) (setq putstring (nth indexc textlista)) (ex:ECSELPUT (+ indexr 2) (+ indexc 1) (vl-princ-to-string putstring)) (ex:ECSELPUT (+ indexr 2) (+ indexc 2) (vl-princ-to-string putstring)) (setq indexc (+ indexc 1)) );end of repeat rows (setq indexr (+ indexr 1)) );end of repeat columns (ex:ECSELPUT 1 1 "handle") (ex:ECSELPUT 1 2 "old text") (ex:ECSELPUT 1 3 "new text") (ex:ECSELPUT 1 6 "How to Use : Fill new text cell > ctrl+a > ctrl+c > in cad run ptext") (setq xlcolumns (vlax-get-property acsheet 'Columns)) (vlax-invoke-method xlcolumns 'AutoFit) (ex:RELEASEEXCELforctcs) (princ) ) (defun c:PTEXT ( / *error* txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist srllen subindex sclist ss1stacklist ss1count index2 enametoedit newtexttoedit objtoedit ) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq srllen (length selectedrowlist)) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) (setq ss1stacklist (mysort scstack)) (setq ss1count (length ss1stacklist)) (setq index2 3) (repeat (- (/ ss1count 3) 1) (setq enametoedit (handent (cadr (nth index2 ss1stacklist)))) (setq newtexttoedit (cadr (nth (+ index2 2) ss1stacklist))) (setq objtoedit (vlax-ename->vla-object enametoedit)) (vlax-put-property objtoedit 'textstring newtexttoedit) (setq index2 (+ index2 3)) ) (LM:endundo (LM:acdoc)) (princ) ) (defun ex:RELEASEEXCELforctcs ( / ) (if (= AcSheet nil) (progn) (progn (vlax-release-object AcSheet) ;(princ "\n Acsheet Release for next time. Complete.") ) ) (if (= Sheets nil) (progn) (progn (vlax-release-object Sheets) ;(princ "\n Sheets Release for next time. Complete.") ) ) (if (= Workbooks nil) (progn) (progn (vlax-release-object Workbooks) ;(princ "\n Workbooks Release for next time. Complete.") ) ) (if (= ExcelApp nil) (progn) (progn (vlax-release-object ExcelApp) ;(princ "\n ExcelApp Release for next time. Complete.") ) ) ) (defun ex:ECSELPUT ( r c textstring / c addr c1 c2 c3 rng textstring2 ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) (vlax-put-property cell 'item r c textstring2) ) (defun ex:ESMAKE ( / ) ;from BIGAL's ah:chkexcel (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) There are already tons of text editing Lisp. inside of CAD, outside of CAD, or batch modifications. so this is for my handent practice. export all text contents of a drawing to Excel with CTEXT command with handle. and put your edits in the 3rd column then copying the whole table, then input PTEXT in CAD the content is pasted in the same text based on the handle. In the case of overlapping or moving, handles were used instead of coordinates. It doesn't matter if you save the Excel file and use it or delete all unnecessary rows. because it use your clipboard
    2 points
  4. IMO DCL is not needed for this simple task. If you format the input correctly and have DYNMODE set to 1, it makes for a pretty clean interface. (defun c:foo (/ a n) (initget 0 (setq a "30 60 90")) (setq n (cond ((getkword (strcat "\nSelect Option [" (vl-string-translate " " "/" a) "] <30>: "))) ("30") ) ) (foreach l '("TEST-PP-30%_Design_Review" "TEST-PP-60%_Design_Review" "TEST-PP-90%_Design_Review") (vl-catch-all-apply 'vla-put-freeze (list (vlax-ename->vla-object (tblobjname "layer" l)) (if (wcmatch l (strcat "*" n "*")) 0 -1 ) ) ) ) (command "_.regen") (princ) )
    2 points
  5. little help from a dragon (defun c:foo (/ n) ;;(or (setq n (getint "\nEnter percent:<30>")) (setq n 30)) (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHbutts : dialog \t{" fo) (write-line " label =\"Choose revision\" ;" fo) (write-line " : row\t{" fo) (write-line " : boxed_radio_row\t{" fo) (write-line " : radio_button\t{" fo) (write-line " key = \"Rb1\";" fo) (write-line " label = \"30%\";" fo) (write-line " }" fo) (write-line " spacer_1 ;" fo) (write-line " : radio_button\t{" fo) (write-line " key = \"Rb2\";" fo) (write-line " label = \"60%\";" fo) (write-line " }" fo) (write-line " spacer_1 ;" fo) (write-line " : radio_button\t{" fo) (write-line " key = \"Rb3\";" fo) (write-line " label = \"90%\";" fo) (write-line " }" fo) (write-line " spacer_1 ;" fo) (write-line " } " fo) (write-line " }" fo) (write-line " spacer_1 ;" fo) (write-line " ok_only;" fo) (write-line "}" fo) (close fo) (setq dcl_id (load_dialog fn)) (new_dialog "AHbutts" dcl_id) (set_tile "Rb1" "1") (action_tile "Rb1" "(setq n \"30%\")(done_dialog)") (action_tile "Rb2" "(setq n \"60%\")(done_dialog)") (action_tile "Rb3" "(setq n \"90%\")(done_dialog)") (action_tile "accept" "(setq n \"30%\")(done_dialog)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete fn) (foreach l '( "TEST-PP-30%_Design_Review" "TEST-PP-60%_Design_Review" "TEST-PP-90%_Design_Review") (vl-catch-all-apply 'vla-put-freeze (list (vlax-ename->vla-object (tblobjname "layer" l)) (if (wcmatch l (strcat "*" n "*")) 0 -1 ) ) ) ) (command "_.regen") (princ) )
    2 points
  6. ; cleanREC - 2022.06.30 exceed ; https://www.cadtutor.net/forum/topic/75518-rectangles-to-snaps-resizing/ ; Round the length of the rectangle line according to the fuzz factor. Enter 5 in units of 5, enter 10 in units of 10, ; Optionally, the center coordinates can also be rounded. (vl-load-com) (defun c:cleanrec ( / fuzzfactor coordalso ss ssl index obj type coord coordlen coordpairs closedyn pt1x pt2x pt1y pt2y centerx centery xlen ylen xlenfuzz ylenfuzz newcoord ) (setq fuzzfactor (getreal "\n input roundup fuzzy factor : ")) (setq coordalso (getstring "\n you need roundup center coordinates also? (Y - Yes / SpaceBar - No) : \n")) (setq ss (ssget ":L" '((0 . "*LINE")))) (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq type (vlax-get-property obj 'entityname)) (cond ((= type "AcDbLine") (princ "\n skip line at this step") ) ((= type "AcDbPolyline") (setq coord (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates)))) (setq coordlen (length coord)) (setq coordpairs (/ coordlen 2)) ;(princ coordpairs) (setq closedyn (vlax-get-property obj 'closed)) ;(princ closedyn) (cond ((and (= coordpairs 4) (= closedyn :vlax-true)) (setq pt1x (car coord)) (setq pt1y (cadr coord)) (setq pt2x (nth 4 coord)) (setq pt2y (nth 5 coord)) (setq centerx (/ (+ pt1x pt2x) 2)) (setq centery (/ (+ pt1y pt2y) 2)) (if (= (strcase coordalso) "Y") (progn (setq centerx (LM:roundup centerx fuzzfactor)) (setq centery (LM:roundup centery fuzzfactor)) ) ) (setq xlen (abs (- pt2x pt1x))) (setq ylen (abs (- pt2y pt1y))) (setq xlenfuzz (LM:roundup xlen fuzzfactor)) (setq ylenfuzz (LM:roundup ylen fuzzfactor)) (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) )) (princ "\n new coord - ") (princ newcoord) (vlax-put-property obj 'coordinates (vlax-make-variant newcoord)) ) ((and (= coordpairs 5) (= (car coord) (nth (- coordlen 2) coord)) (= (cadr coord) (last coord))) (setq pt1x (car coord)) (setq pt1y (cadr coord)) (setq pt2x (nth 4 coord)) (setq pt2y (nth 5 coord)) (setq centerx (/ (+ pt1x pt2x) 2)) (setq centery (/ (+ pt1y pt2y) 2)) (if (= (strcase coordalso) "Y") (progn (setq centerx (LM:roundup centerx fuzzfactor)) (setq centery (LM:roundup centery fuzzfactor)) ) ) (setq xlen (abs (- pt2x pt1x))) (setq ylen (abs (- pt2y pt1y))) (setq xlenfuzz (LM:roundup xlen fuzzfactor)) (setq ylenfuzz (LM:roundup ylen fuzzfactor)) (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)))) (princ "\n new coord - ") (princ newcoord) (vlax-put-property obj 'coordinates (vlax-make-variant newcoord)) ) (t (princ "\n this is not rectangle") ) ) ) ) (setq index (+ index 1)) ) (princ) ) ;; Round Up - Lee Mac ;; Rounds 'n' up to the nearest 'm' (defun LM:roundup ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m)) ) It seems I'm late for the party, but please try my dessert In the gif, an exaggerated rectangle is used to emphasize the effect. This gets the coordinates of the polyline rectangle, If there are 4 dots, check if they are closed In the case of 5, check whether the beginning and the end points are the same. for determines the rectangle. Then, calculate the x-length and y-length with the LL (No. 1) and UR (No. 3) points of the rectangle. The center point is also calculated from the LL and UR points. After that, round the x-length and y-length with Lee Mac's roundup function, Optionally, the center coordinates can also be rounded. divide by half and add or subtract from the center point to create a new coordinates list and then input it to the polyline. What this routine lacks is that it has the same number of points as a square, but a different shape, such as a diamond, a trapezoid. did not assume It can be made by entering the Angle part into cond + this is version 2 ; cleanREC2 - 2022.06.30 exceed ; https://www.cadtutor.net/forum/topic/75518-rectangles-to-snaps-resizing/ ; Round the length of the rectangle line according to the fuzz factor. Enter 5 in units of 5, enter 10 in units of 10, ; Optionally, the center coordinates can also be rounded. (vl-load-com) (defun c:cleanREC2 ( / fuzzfactor coordalso ss ssl index obj type coord coordlen coordpairs closedyn pt1x pt1y pt2x pt2y pt3x pt3y pt4x pt4y centerx centery xlen ylen xlenfuzz ylenfuzz newcoord ) (setq fuzzfactor (getreal "\n input roundup fuzzy factor : ")) (setq coordalso (getstring "\n you need roundup center coordinates also? (Y - Yes / SpaceBar - No) : \n")) (setq ss (ssget ":L" '((0 . "*LINE")))) (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq type (vlax-get-property obj 'entityname)) (cond ((= type "AcDbLine") (princ "\n skip line at this step") ) ((= type "AcDbPolyline") (setq coord (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates)))) (setq coordlen (length coord)) (setq coordpairs (/ coordlen 2)) ;(princ coordpairs) (setq closedyn (vlax-get-property obj 'closed)) ;(princ closedyn) (cond ((and (= coordpairs 4) (= closedyn :vlax-true)) (setq pt1x (car coord)) (setq pt1y (cadr coord)) (setq pt2x (nth 2 coord)) (setq pt2y (nth 3 coord)) (setq pt3x (nth 4 coord)) (setq pt3y (nth 5 coord)) (setq pt4x (nth 6 coord)) (setq pt4y (nth 7 coord)) (setq centerx (/ (+ (/ (+ pt1x pt3x) 2) (/ (+ pt2x pt4x) 2)) 2)) (setq centery (/ (+ (/ (+ pt1y pt3y) 2) (/ (+ pt2y pt4y) 2)) 2)) (if (= (strcase coordalso) "Y") (progn (setq centerx (LM:roundup centerx fuzzfactor)) (setq centery (LM:roundup centery fuzzfactor)) ) ) (setq xlen (/ (+ (distance (list pt1x pt1y) (list pt2x pt2y)) (distance (list pt4x pt4y) (list pt3x pt3y))) 2)) (setq ylen (/ (+ (distance (list pt1x pt1y) (list pt4x pt4y)) (distance (list pt2x pt2y) (list pt3x pt3y))) 2)) (setq xlenfuzz (LM:roundup xlen fuzzfactor)) (setq ylenfuzz (LM:roundup ylen fuzzfactor)) (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) )) (princ "\n new coord - ") (princ newcoord) (vlax-put-property obj 'coordinates (vlax-make-variant newcoord)) ) ((and (= coordpairs 5) (= (car coord) (nth (- coordlen 2) coord)) (= (cadr coord) (last coord))) (setq pt1x (car coord)) (setq pt1y (cadr coord)) (setq pt2x (nth 2 coord)) (setq pt2y (nth 3 coord)) (setq pt3x (nth 4 coord)) (setq pt3y (nth 5 coord)) (setq pt4x (nth 6 coord)) (setq pt4y (nth 7 coord)) (setq centerx (/ (+ (/ (+ pt1x pt3x) 2) (/ (+ pt2x pt4x) 2)) 2)) (setq centery (/ (+ (/ (+ pt1y pt3y) 2) (/ (+ pt2y pt4y) 2)) 2)) (if (= (strcase coordalso) "Y") (progn (setq centerx (LM:roundup centerx fuzzfactor)) (setq centery (LM:roundup centery fuzzfactor)) ) ) (setq xlen (/ (+ (distance (list pt1x pt1y) (list pt2x pt2y)) (distance (list pt4x pt4y) (list pt3x pt3y))) 2)) (setq ylen (/ (+ (distance (list pt1x pt1y) (list pt4x pt4y)) (distance (list pt2x pt2y) (list pt3x pt3y))) 2)) (setq xlenfuzz (LM:roundup xlen fuzzfactor)) (setq ylenfuzz (LM:roundup ylen fuzzfactor)) (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)))) (princ "\n new coord - ") (princ newcoord) (vlax-put-property obj 'coordinates (vlax-make-variant newcoord)) ) (t (princ "\n this is not rectangle") ) ) ) ) (setq index (+ index 1)) ) (princ) ) ;; Round Up - Lee Mac ;; Rounds 'n' up to the nearest 'm' (defun LM:roundup ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m)) ) calculate the length of one side of a rectangle has been written in more detail. this Works better for rotated rectangles.
    2 points
  7. (vla-put-color obj 1) ;sets the color of the object (vla-put-color obj (acad_colordlg 1)) ;sets the color of the object
    2 points
  8. Here's another way to set layer colors with a pick... will do index, truecolor and colorbooks. Could easily be modified to set the object color. (defun c:clc (/ c d e l n) ;; RJP » 2018-08-17 ;; Set layer color by pick (or (getenv "clc") (setenv "clc" "(62 . 1)")) (cond ((setq c (acad_truecolordlg (read (getenv "clc")))) (setenv "clc" (vl-prin1-to-string (last c))) (setq d (vla-get-activedocument (vlax-get-acad-object))) (while (setq e (nentsel "\nSelect entity to change layer color: ")) (foreach x (append (list (car e)) (cadddr e)) (cond ((setq n (cdr (assoc 8 (entget x)))) (setq l (tblobjname "layer" n)) (and (not (wcmatch n "0")) (entmod (append (entget l) c))) ) ) ) ) (vla-regen d acactiveviewport) ) ) (princ) )
    1 point
  9. Picking a point is my preference, often for me the rectangles are electrical panels and are lined up against walls, specifying an insertion point for each would be useful in that case Exceed - that looks good, I'll have to sit down and work out what you are doing - busy week this week, so might be next week I get chance, thanks. Questions about it later no doubt
    1 point
  10. thank you so much ! working properly now. Thank you @ronjonpfor the code.. @BIGALfor the radio button and @mhuppfor merging the 2 lisps together. thanks so much! appreciate your great help
    1 point
  11. oops again didn't look closely at @ronjonp super clean code. just change the following since I'm setting strings with the dcl instead of a number (if (wcmatch l (strcat "*" (itoa n) "*")) to (if (wcmatch l (strcat "*" n "*")) It will be a little harder to "add" things (write-line " : radio_button\t{" fo) (write-line " key = \"Rb#\";" fo) ;replace # with a number 1-3 are taken (write-line " label = \"@@@@\";" fo) ;what it will show (write-line " }" fo) (write-line " spacer_1 ;" fo) .... (action_tile "Rb#" "(setq n \"@@@@\")(done_dialog)") also add the layer name to the l list
    1 point
  12. look to see where your temp files are being made. run the command but don't pick anything their will be a temp .dcl file there. nm ill just convert it for you. give me a sec.
    1 point
  13. Of course, but you would have to add it to the "Choose revision" list also. (or (setq n (atoi (ah:butts 1 "h" '("Choose revision" "30%" "60%" "90%" "Finished"))))) (foreach l '("TEST-PP-30%_Design_Review" "TEST-PP-60%_Design_Review" "TEST-PP-90%_Design_Review" "TEST-PP-Finished_Design") Basically what you choose has to be in the layer name for this lisp to work properly
    1 point
  14. I am sure Ronjonp will follow up.
    1 point
  15. Are you saving bundle in correct spot.
    1 point
  16. My $ 0.05 "lower left corner (rather then using its centre point for position)" thought the same idea but maybe select a pline segment as the fixed angle, then mid left or right, then the 2 perp sides adjusted to suit say round average of the 2 sides. The top line then would be parallel. If pick 4 points.
    1 point
  17. http://docs.autodesk.com/ACAD_E/2012/ENU/filesDXF/WS1a9193826455f5ff18cb41610ec0a2e719-7a62.htm (62 . 61) --edit put this in your command line (acad_colordlg 61)
    1 point
  18. Capitalization matters also its better to use setvar (defun C:TestAutoLoad () (Alert "Test") (Alert "Test2") (setvar 'clayer "Defpoints") (princ) ) (C:TestAutoLoad)
    1 point
  19. This will convert any dim that has text overridden with distof. --edit updated code to store the old override (undo command?) in the suffix also adds text above the dim of the old dimoverride Note this command should be a temp fix --edit didn't account for dims at different angles. (defun C:DIM-Convert (/ ss dim obj old dist off hgt pt) (if (setq ss (ssget '((0 . "DIMENSION")))) (foreach dim (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq obj (vlax-ename->vla-object dim)) (if (eq (setq old (vlax-get obj 'TextOverride)) "") (progn) (progn (setq dist (distof old)) (vla-put-textoverride obj dist) (vla-put-textsuffix obj old) ;store old overide ;(setq off (* (setq hgt (vlax-get obj 'TextHeight)) 1.5)) ;(setq pt (vlax-get obj 'TextPosition)) ;(setq pt (list (car pt) (+ (cadr pt) off))) ;(entmake (list '(0 . "TEXT")(cons 10 pt)(cons 11 pt)(cons 40 hgt)(cons 1 old)'(072 . 4))) ) ) ) ) (princ) )
    1 point
  20. I keep being second to answer after Mhupp.. I spent a lot of time getting things wrong, still do, one thing that sometimes happens for me is that I set a global variable after I have used it, so on the second pass it picks up the value but in the first it doesn't do anything. For example (defun c:anexample ( / ) (setq MyNextBlockName "AThing") (if (= MyBlockName "AThing") (princ MyBlockName) ) (setq MyBlockName MyNextBlockName) (princ) ) Run it once, nothing, run it again and it displays "AThing" int he command line The other thing that often happens is it picks up a global variable from another unrelated LISP and tries to use that first off. For example I often use 'acount' in loops so if LISP 1 sets acount to 10 then LIPS2 might be: For example (defun c:Lisp1 ( / ) (setq acount 10) ) (defun c:anexample ( / ) (while (< acount 5) (princ "\n") (princ acount) (setq (+ acount 1)) ) (setq acount 0) ;;reset counter for next use ) Welcome to world of debugging a LISP! Frustrates me when in my head it all works OK, but my fingers decide to type other things in Oh, last thing.. spelling mistakes...
    1 point
  21. Where/how is co, ip1, ip2 being set? This is probably your issue. --edit Another way of calculating the different points. (setq co (mapcar '+ co '(0 -6 0))) (setq ip1 (mapcar '+ ip1 '(0 -6 0))) (setq ip2 (mapcar '+ ip2 '(0 -6 0))) (setq rip1 (mapcar '+ co '(-2 -3 0))) (setq rip2 (mapcar '+ co '(3 2 0))) (setq hip (mapcar '+ co '(1 -2 0)))
    1 point
  22. One lisp file is better than two : a lisp file and a dcl file. But I have tons of dcl files so just for fun (Grrr knows all about fun) decided to make a tiny lisp in my lunch break to make this just a little bit more easier for me, myself and I. Probably not the first with this idea , haven't checked it (maybe I should have...) , also haven't tested it much (also should have done this) but hey , almost weekend... so go check youself! ; RLX - 25 Jan 2019 - just another luchtime fun (defun RLX_Convert_Dcl ( / dcl-fn dcl-fp lsp-fn lsp-fp dir base inp) (if (and (setq dcl-fn (getfiled "Select DCL file" "" "dcl" 0)) (setq dcl-fp (open dcl-fn "r")) (setq lsp-fn (strcat (setq dir (car (fnsplitl dcl-fn))) (setq base (cadr (fnsplitl dcl-fn))) "_dcl.lsp")) (setq lsp-fp (open lsp-fn "w"))) (progn (princ (strcat "(defun " base "_Write_Dialog ( )\n (if (and (setq " base "-fn " "(vl-filename-mktemp ") lsp-fp) (prin1 (strcat base ".dcl") lsp-fp) (princ (strcat ")) (setq " base "-fp (open " base "-fn \"w\")))\n") lsp-fp) (princ (strcat " (mapcar \n '(lambda (x)(write-line x " base "-fp))\n (list\n") lsp-fp) (while (setq inp (read-line dcl-fp)) (princ " " lsp-fp)(prin1 inp lsp-fp)(princ "\n" lsp-fp)) (princ (strcat " )\n )\n )\n (if " base "-fp (close " base "-fp))\n)") lsp-fp) (close dcl-fp)(close lsp-fp)(gc) ) ) (if (and lsp-fn (findfile lsp-fn))(startapp "notepad" lsp-fn)) (princ) ) ; (RLX_Convert_Dcl) ; original dcl file name : rlx.dcl ; rlx : dialog ; { label = "RLX (RLX Jan'19)"; ; : list_box { key = "lb"; } ; ok_cancel; ; } ; converted to rlx_dcl.lsp: ;(defun rlx_Write_Dialog ( ) ; (if (and (setq rlx-fn (vl-filename-mktemp "rlx.dcl")) (setq rlx-fp (open rlx-fn "w"))) ; (mapcar ; '(lambda (x)(write-line x rlx-fp)) ; (list ; "rlx : dialog" ; " { label = \"RLX (RLX Jan'19)\";" ; " : list_box { key = \"lb\"; }" ; " ok_cancel;" ; " }" ; ) ; ) ; ) ; (if rlx-fp (close rlx-fp)) ; )
    1 point
  23. 1 point
×
×
  • Create New...