Leaderboard
Popular Content
Showing content with the highest reputation since 03/01/2026 in Posts
-
@Nikon The "COND" statement will stop as soon as it meets the criteria for the square area range, so if something else meets the that area range before getting to your desired state, it will never get there. You will have to do a different comparison that is unique to the criteria. Maybe to change the criteria for the conditional statement to comparing the Length and width specifically, rather than with the area, or a combination of the area and the width, or something else, like a unique layer or color. Maybe something like this instead (you can alter to suit the fudge factor for the viewport height and width): (cond ((and (> 290.0 ViewPortHeight 300.0) (> 600.0 ViewPortWidth 650.0));; Compare the width and height directly! (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 630.00мм)") ) ((and (> 290.0 ViewPortHeight 300.0) (> 835.0 ViewPortWidth 845.0)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 841.0мм)") ) ... ;; Repeat for all desired sizes ) NOTE: You would also have to do both a landscape version and a Portrait version if you need both. Perhaps a bit more sophisticated comparison: (cond ((or (and (> 290.0 ViewPortHeight 300.0) (> 600.0 ViewPortWidth 650.0)) (and (> 290.0 ViewPortWidth 300.0) (> 600.0 ViewPortHeight 650.0)) ) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 630.00мм)") ) ((or (and (> 290.0 ViewPortHeight 300.0) (> 835.0 ViewPortWidth 845.0)) (and (> 290.0 ViewPortWidth 300.0) (> 835.0 ViewPortHeight 845.0)) ) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 841.0мм)") ) ... ; Repeat for all desired sizes (T (vla-put-ConfigName Layout "None")) ; Default to No plotter for non-standard sizes ) NOTE: I can't test this directly without a "real world" sample drawing to compare, along with your pc3 file, so I'm trying to give you the knowledge to do it yourself, which is preferrable anyway.2 points
-
You must've copied the changes into your code incorrectly. "RH: DXF" is already defined in your original code. (defun rh:dxf (code lst) (cdr (assoc code lst))) Attached is your original code with @mhupp's change: (defun rh:dxf (code lst) (cdr (assoc code lst))) (defun c:aa ( / cmde ent e_typ e_lst area vtx x_lst y_lst z_lst x_pt y_pt z_pt c_lst v_lst ss sum) (cond ( (/= 0 (getvar 'cmdecho)) (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) ) ) (while (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE,LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 3) (70 . 5) (-4 . "OR>") ) )) (setq ent (ssname ss 0) e_typ (rh:dxf 0 (setq e_lst (entget ent))) area (getpropertyvalue ent "area") v_lst nil ) (cond ( (= e_typ "POLYLINE") (setq ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) (while (/= "SEQEND" (cdr (assoc 0 (entget ent)))) (setq v_lst (cons vtx v_lst) ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) (if (= (setq sum (apply '+ (mapcar '(lambda (x) (caddr x)) v_lst))) 0.0) (setq z_pt 0.0) (setq z_pt (/ sum (length v_lst))) ) ) ( (= e_typ "LWPOLYLINE") (setq z_pt (rh:dxf 38 e_lst)) (foreach pr e_lst (if (= (car pr) 10) (setq v_lst (cons (cdr pr) v_lst))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) ) ) (setq c_lst (list x_pt y_pt z_pt)) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 c_lst) (cons 40 (getvar 'textsize)) (cons 71 5) (cons 72 5) (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m" (chr 0178))) ; (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m²")) ; (cons 1 (rtos (/ area 1000000.0) 2 3)) ; If you don't need the suffix "m²" ) ) ) (if cmde (setvar 'cmdecho cmde)) )2 points
-
chr instead of string. (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m" (chr 0178))) also might be the font your using. https://www.cadtutor.net/forum/topic/75383-text-ascii/#findComment-5962262 points
-
2 points
-
100% setenv is writing strings to your windows registry. not good if you are doing that for all variables. might want to check to see what else you have been writing there. HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R##.#\ACAD-####:###\Profiles\<<Unnamed Profile>>\Variables tho setenv will persist even after reboot. overkill for most variables need in lisp. like @pkenewell said you should be good with just global variables. that holds while the drawing is open but make them unique. if you need to hold a variable in the drawing itself. use ldata that will persist in the drawing. so you can close and reopen it.2 points
-
Or using the method proposed by @Stefan BMR we could automate in lisp like this: (enter the distances when the cursor is on the tracking line to get the desired angles) (defun des_vec (lst col / lst_sg) (setq lst_sg (list (cadr lst) (car lst))) (setq lst (cdr lst)) (while lst (if (cadr lst) (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg))) ) (setq lst (cdr lst)) ) (setq lst_sg (cons col lst_sg)) (grvecs lst_sg) ) (defun c:pl90-45 ( / old_set p1 p2 lst_pt msg) (setq old_set (mapcar 'getvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE"))) (initget 33) (setq p1 (getpoint "\nPick start point: ")) (initget 33) (setq p2 (getpoint p1 "\nReference start angle: ") lst_pt (list (list (car p1) (cadr p1))) msg "\nGive distanve in the direction of cursor: " ) (mapcar 'setvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE") (list 0 0 (angle p1 p2) (* 0.25 pi) 3 2 (angle p1 p2) 1) ) (initget 303) (while (and (setq p2 (getpoint p1 msg)) (/= p2 "C")) (cond ((/= p2 "U") (setq p2 (list (car p2) (cadr p2))) (mapcar 'setvar '("AUTOSNAP" "SNAPANG" "ORTHOMODE") (list 10 (angle p1 p2) 0) ) (setq p1 p2 lst_pt (cons p2 lst_pt) msg "\nGive distanve in the direction of cursor or [C/U] for Close or Undo : " ) ) (T (setq lst_pt (cdr lst_pt) p1 (car lst_pt) ) ) ) (redraw) (des_vec lst_pt 7) (initget 302 "C U") ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (getvar "CLAYER")) '(100 . "AcDbPolyline") (cons 90 (length lst_pt)) (if (= p2 "C") '(70 . 1) '(70 . 0)) ) (mapcar '(lambda (x) (cons 10 x)) lst_pt) ) ) (mapcar 'setvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE") old_set) (prin1) )2 points
-
fixed an error with substr to only remove the first char of the string. and added your + option.2 points
-
@mhupp great code no reason why input could not be 7.7;-12;22.8;12;-5.9;21.6;-0.5;\3.5;8;2.5;\1.5;13.8 in this case each leg is separated by a semi colon, or more often a comma is used. Could type in say notepad and copy and paste to a getstring. The reason for the paste rather than type direct would be if made a mistake you UNDO fix in notepad and do again. Use "parse to list" defun. @Ataim what do you think about that idea ?2 points
-
2 points
-
Your points will fall on the grid lines not inside the boxes created by the grid lines.2 points
-
In other words, you are having trouble understanding the concept of interpolation, correct? The mathematical interpolation of contours goes like this. Let's say we have two spot elevations A & B. A = 32.7 and B = 54.0. The distance between A & B = 50 feet. We want to know where our 40-foot contour would fall between spot elevations A & B. First obtain the total elevation difference. This is done by subtracting A from B. 54.0 minus 32.7 = 21.3. Next, we want the difference in elevation between our 40-contour interval and the nearest spot elevation which in this case is A or 32.7. That works out to be 7.3. Now we need to calculate the distance (let's call this "d") we need to go from spot elevation A to our 40-foot contour. That takes the form of: d/7.3=50/21.3 or d=7.3*50/21.3 = 7.3*2.347 = 17.13 or the distance, in decimal feet, to our 40-foot contour. Got all that? Good. Now go start interpolating.2 points
-
I am not good as the others but try this. It will build what you want to achieve but not exactly as what was shown in the image. Maybe other can improve the code. (defun c:LayerLegend (/ doc lays lay laylist layname laycolor laydesc pt x y starty rowH txtH headH colHT col1 col2 col3 totalH legendBlock w) (defun GetTextWidth (txt height / doc ms txtObj minp maxp w) (if (or (not txt) (= txt "")) 0 (progn (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq ms (vla-get-ModelSpace doc)) ;; create temp text off-screen (setq txtObj (vla-AddText ms txt (vlax-3d-point -1000 -1000 0) height)) ;; initialize safearrays (setq minp (vlax-make-safearray vlax-vbDouble '(0 . 2))) (setq maxp (vlax-make-safearray vlax-vbDouble '(0 . 2))) ;; get bounding box safely (vl-catch-all-apply '(lambda () (vla-GetBoundingBox txtObj 'minp 'maxp) )) ;; width in X direction (setq w (abs (- (vlax-safearray-get-element maxp 0) (vlax-safearray-get-element minp 0)))) ;; delete temp text (vla-Delete txtObj) w ) ) ) (vl-load-com) (setq rowH 8.0) (setq txtH 2.0) (setq headH 2.5) (setq colHT 1.0) (setq col1 35.0) ;; fixed column 1 width (setq col2 50.0) ;; fixed column 2 width (setq col3 65.0) ;; fixed column 3 width (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq lays (vla-get-Layers doc)) (setq laylist '()) (vlax-for lay lays (setq layname (vla-get-name lay)) (setq laydesc (if (vlax-property-available-p lay 'Description) (vla-get-description lay) "")) ;; Skip 0, Defpoints, XREF (if (and (/= layname "0") (/= (strcase layname) "DEFPOINTS") (not (vl-string-search "|" layname))) (progn (setq laycolor (vla-get-color lay)) (setq laylist (cons (list layname laycolor laydesc) laylist)) ) ) ) (setq laylist (vl-sort laylist '(lambda (a b) (< (strcase (car a)) (strcase (car b)))) ) ) (if (setq legendBlock (tblsearch "BLOCK" "LAYERLEGEND_MARK")) (command "_.erase" "B" "LAYERLEGEND_MARK" "") ) (setq pt (getpoint "\nPick insertion point: ")) (setq x (car pt)) (setq y (cadr pt)) (setq starty y) (setq totalH (* rowH (+ (length laylist) 1))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list (+ x col1 col2 col3) starty 0)))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x 3) (- y 5) 0)) (cons 40 headH) (cons 1 "COLOR NUMBER"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 3) (- y 5) 0)) (cons 40 headH) (cons 1 "LAYER NAME"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 5) 0)) (cons 40 headH) (cons 1 "DESCRIPTION"))) ;; header bottom line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) (foreach L laylist (setq layname (nth 0 L)) (setq laycolor (nth 1 L)) (setq laydesc (nth 2 L)) ;; Color number text (1 mm) on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x 3) (+ y -2.2) 0)) (cons 40 colHT) (cons 1 (itoa laycolor)))) ;; Sample line on its layer (entmakex (list '(0 . "LINE") (cons 8 layname) (cons 10 (list (+ x 3) (- y 3) 0)) (cons 11 (list (+ x col1 -3) (- y 3) 0)))) ;; Layer name text on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x col1 3) (- y 4) 0)) (cons 40 txtH) (cons 1 layname))) ;; Description text (Layer 0) (entmakex (list '(0 . "TEXT") (cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 4) 0)) (cons 40 txtH) (cons 1 laydesc))) ;; Row horizontal line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) ) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list x (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1) starty 0)) (cons 11 (list (+ x col1) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2) starty 0)) (cons 11 (list (+ x col1 col2) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2 col3) starty 0)) (cons 11 (list (+ x col1 col2 col3) (- starty totalH) 0)))) (princ) )2 points
-
Nice program as always Tharwat. I think what the OP need is create a table as attached for visual reference.2 points
-
I would ask that you delete your drawings. Why? Because another student could come along and borrow them, make minor changes then submit them as their own drawings thus saving hours of labor. You do all the work and they get the credit. Not kosher at all. Follow me? Addendum: Looks like someone has already done exactly that. Again, take your drawings down. There are plenty of image files (not CAD files for students) to reference. Thank you.2 points
-
Here's my program : https://autolispprograms.wordpress.com/create-layers-from-excel-file/2 points
-
This is what I use, I think the root LISP is the same as the OPs, over time I have added to it: txtfindreplace ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 (defun FindReplace (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen# acount) (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$) ) (setq acount 0) (while Loop (setq Mid$ (substr NewStr$ Cnt# FindLen#)) (if (= Mid$ Find$) (progn (setq acount (+ acount 1)) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#))) Cnt# (+ Cnt# ReplaceLen#) );setq );end progn (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while (list NewStr$ acount) );defun FindReplace (defun FindReplaceNew (Find$ Replace$ / SS acounter acount ent1 entlist1 entcodes1 EntType Text$ text01 ReplaceWith$ FoundReplaced NewTxt MyBlockEntList BlockCounter ) ;;;Sub Routines ;;;; ;;;;;;;;;;;;;;;;;;;; ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-entities-inside-a-block/td-p/2644829 (defun getblkitems ( EntName / sel items) ;;Blocks: (setq nfo (entget EntName)) (progn (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object) ) ) (cdr (assoc 2 nfo)) ) (setq items (cons (vlax-vla-object->ename item) items)) ) ;end vlax ) ; end progn ) ;end defun (defun updateblock ( EntType ent1 entlist1 acount Find$ Replace$ / MyBlockEntList BlockCounter EntType2 ent2 entlist2 ) (if (= EntType "INSERT") (progn ;;Updates block texts & block blocks (setq MyBlockEntList (getblkitems ent1) ) (setq BlockCounter 0) (while (< BlockCounter (length MyBlockEntList)) (setq ent2 (nth BlockCounter MyBlockEntList)) (setq entlist2 (entget ent2)) (setq EntType2 (cdr (assoc 0 entlist2)) ) ;;Attrributes (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$)) ;;Texts (if (or (= EntType2 "TEXT")(= EntType2 "MTEXT")(= EntType2 "MULTILEADER")) ;;attributes? (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ); end if ;;Changes Dimensions (if (or (= EntType2 "DIMENSION") ) (if (= (cdr (assoc 1 entlist2)) "") ;;if has text over ride () (progn (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ;;same as text -if- ent code 4 used (command ".-refedit" (cdr (assoc 10 entlist1)) "ok" "all" "yes") ;;update block definition (command "refclose" "s") );end progn ) ;end if ); end if (if (= EntType2 "ACAD_TABLE") (setq acount (UpdateTable EntType2 ent2 entlist2 acount Find$ Replace$)) );end if (if (= EntType2 "INSERT") ;;Blocks (setq acount (updateblock EntType2 ent2 entlist2 acount Find$ Replace$)) );end if (setq BlockCounter (+ BlockCounter 1)) ) ; end while );end progn );end if acount ) ;;End Blocks ;;;;;;;;;;;;;;;;;;;; (defun updateattribvalues (EntType ent1 entlist1 acount Find$ Replace$ / ) (setq EntName^ ent1 EntList@ entlist1 EntType$ EntType Text$ (cdr (assoc 1 EntList@)) );setq (if (= EntType$ "INSERT") (if (assoc 66 EntList@) (progn (while (/= (cdr (assoc 0 EntList@)) "SEQEND") (setq EntList@ (entget EntName^)) (if (= (cdr (assoc 0 EntList@)) "ATTRIB") (progn (setq Text$ (cdr (assoc 1 EntList@))) (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq FoundReplaced (FindReplace Text$ Find$ Replace$)) (setq ReplaceWith$ (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );progn );end if attrib (setq EntName^ (entnext EntName^)) );while );progn );if );if acount ) ;end defun ;;;;;;;;;;;;;;;;;;;; (defun updatetext (EntType ent1 entlist1 acount Find$ Replace$ / entcodes1 FoundReplaced NewTxt) (progn (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text. (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (if (= text01 nil) () (progn (setq FoundReplaced (FindReplace text01 Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (addinnewtext NewTxt entlist1 ent1) )) ;end progn, end if ) ; end progn acount ) ;;;;;;;;;;;;;;;;;;;; (defun UpdateTable ( EntType ent1 entlist1 acount Find$ Replace$ / text01 Newentlist1 counter) (setq counter 0) (setq Newentlist1 '()) (while (< counter (length entlist1)) (if (or (= (nth 0 (nth counter entlist1)) 1)(= (nth 0 (nth counter entlist1)) 302) ) (progn (setq text01 (cdr (nth counter entlist1))) (setq FoundReplaced (FindReplace text01 Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (setq text01 NewTxt) (setq Newentlist1 (append Newentlist1 (list (cons (nth 0 (nth counter entlist1)) text01)))) ) ;end progn (setq Newentlist1 (append Newentlist1 (list (nth counter entlist1)))) ;;ignore entity item ) ;end if (setq counter (+ counter 1)) ) ;end while (setq entlist1 Newentlist1) (entmod entlist1) (entupd ent1) acount ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;end subroutines 'findreplace' (setq acount 0) (setq acounter 0) (command "UNDO" "BEGIN") (setq SS (ssget "x" (list '(-4 . "<AND") '(-4 . "<OR") '(0 . "*TEXT") '(0 . "INSERT") '(0 . "ATTDEF") '(0 . "ATTRIB") '(0 . "DIMENSION") '(0 . "*LEADER") '(0 . "POSITIONMARKER") '(0 . "*TABLE") '(-4 . "OR>") (cons 410 (getvar "CTAB")) '(-4 . "AND>") ))) ; end setq, end ss, end list ;;;FILTER SS to text string (while (< acounter (sslength SS)) (setq ent1 (ssname SS acounter)) (setq entlist1 (entget ent1)) (setq EntType (cdr (assoc 0 entlist1)) ) (setq Text$ (cdr (assoc 1 entlist1)) ) ;;change this line to get all texts inc. long texts etc. ;;Changes Attribute Values - In Blocks (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$)) ;;Changes Block Texts (if (= EntType "INSERT") (setq acount (updateblock EntType ent1 entlist1 acount Find$ Replace$)) );end if ;;Changes Texts (if (or (= EntType "MTEXT")(= EntType "TEXT") (= EntType "MULTILEADER") (= EntType "POSITIONMARKER") ) (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ); end if (if (or (= EntType "DIMENSION") ) (if (= (cdr (assoc 1 entlist1)) "") ;;if has text over ride () (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ;;same as text -if- ent code 4 used ) ); end if (if (or (= EntType "ATTDEF")(= EntType "ATTRIB") ) (progn (setq ent2 (entget ent1)) (setq AttText (cdr (assoc 2 ent2))) (setq FoundReplaced (FindReplace AttText Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (setq newval Replace$) (entmod (subst (cons 2 NewTxt) (assoc 2 ent2) ent2)) (entupd ent1) );end progn ); end if (if (= EntType "ACAD_TABLE") (setq acount (UpdateTable EntType ent1 entlist1 acount Find$ Replace$)) );end if (setq acounter (+ 1 acounter)) ) ; end while (command "REGEN") (command "UNDO" "END") acount );defun FindReplaceNew (defun c:txtFindReplace( / old_text new_text) (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): ")) (setq new_text (getstring T "NEW Text: ")) (princ "Changes: ") (princ (FindReplaceNew old_text new_text) ) (princ) )2 points
-
The OP seems to have exited the conversation, but just for others with the same inquiry. As I have mentioned, this is mostly an issue with your PDF editor, the instructions for using the OCR should be in Foxit Help. If this is something you need to do going forward without any effort, you need to use TTF.2 points
-
As most of us use Microsoft Office products I switched from using AutoCAD's Swiss Lt BT TrueType font to ArialNarrow.ttf like SLW210 suggested as it's horizontally compressed to take up less space while being even more easily readable. While hindsight doesn't fix your immediate problem finding a font that doesn't cause issues with your PDF software before you need to output one to PDF again would solve your issues in the future. I've struggled with the same issue even with the full paid version of Adobe with drawings by others usually because of SHX text with various width factors. Never do that with a DWG you want to output to PDF unless you don't want anyone to convert that text back again.2 points
-
I opened your PDF in Acrobat Pro and the text was editable. This seems to be a Foxit issue, though as mentioned, you might want to use a TTF font if that's what Foxit needs. ArialNarrow.ttf is a common replacement IIRC to ISOCP.shx2 points
-
Thanks, I'll try it. There is another option, but it does not work for all formats. ;; A3x3 (420x891) ((and (<= SideS 425) (<= SideL 896)) (vla-put-CanonicalMediaName Layout "UserDefinedMetric (891.00 x 420.00мм)"))1 point
-
just FYI for @ScottMC That while loop is running 1000's times a sec and is intended to only pause waiting for user input to be completed. Can be simplified to this. (while (> (getvar 'CMDACTIVE) 0) (Command "\\") ) Another option would be to use grread and grdraw to show a visualization of a circle but not actually add it to the drawing (in red). Tho I found out it can only draws lines and you need to trick it to make segmented circles. will post something later tonight. -- Edit This doesn't have any command so doesn't need above code or to toggle CMDECHO. ;;----------------------------------------------------------------------;; ;; 2 Point Circle ;; grcircle function from https://lee-mac.com/circletangents.html (defun c:C2 (/ *error* cr P1 P2 P3 rad ev oe os doc) (defun *error* (msg) (setvar 'OSMODE os) (vla-endundomark doc) (princ (strcat "\n" msg)) ) (defun grcircle (cen rad / ang) (setq ang 0.0) (repeat ctan:res (grdraw (polar P3 ang rad) (polar P3 (setq ang (+ ang ctan:inc)) rad) 1) ) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-startundomark doc) (setq ctan:res 40 ;; arc resolution (int > 0) ctan:2pi (+ pi pi) ctan:inc (/ ctan:2pi ctan:res) ) (setq os (getvar 'OSMODE)) (while (and (setvar 'OSMODE (boole 7 os 512)) (setq P1 (getpoint "\nSpecify 1st Point of 2P.Circle: ")) ) (setvar 'osmode os) (prompt "\nSpecify 2nd Point: ") (while (progn (setq ev (grread t 13 0)) (= (car ev) 5) ) (redraw) (setq P2 (cadr ev)) (setq rad (/ (distance P1 P2) 2.0)) (setq P3 (Polar P1 (angle P1 P2) rad)) (grcircle P3 rad) ) (if (= (car ev) 3) (progn (setq P2 (cadr ev)) (setq rad (/ (distance P1 P2) 2.0)) (setq P3 (polar P1 (angle P1 P2) rad)) (setq cr rad) (redraw) (princ (strcat "\n Coordinates: " (setq C2:pp (strcat (rtos (car P3) 2 4) "," (rtos (cadr P3) 2 4) "," (rtos (caddr P3) 2 4))) "\n Diameter: " (rtos (* cr 2) 2 4) " | Radius: " (rtos cr 2 4))) (entmakex (list '(0 . "POINT") (cons 10 P3))) (entmakex (list '(0 . "POINT") (cons 10 P2))) (entmakex (list '(0 . "CIRCLE") (cons 10 P3) (cons 40 cr) (cons 8 (getvar "CLAYER")))) ) ) ) (setvar 'cmdecho 1) (vla-endundomark doc) (princ) )1 point
-
Thanks PK for finding that. Something I've never found or got direct connection to error but now will have that as an understood rule. Will certainly look for that in my troubleshooting.1 point
-
If you look at this snippet of code it is all the values required, insert correct title block and make a viewport. This is for one viewport, multiple title blocks. (cond ((= ntitle "A0_Landscape") (setq ht 780.0 wid 1160.0 xpt 878.0 xwid 62.0 yht 32.0)) ((= ntitle "A1_Landscape") (setq Ht 541.0 wid 831.0 xpt 542.0 xwid 62.0 yht 32.0)) ((= ntitle "A1_Portrait") (setq Ht 774.0 wid 571.0 xpt 229.0 xwid 62.0 yht 32.0)) ((= ntitle "A2_Landscape") (setq ht 367.0 wid 584.0 xpt 295.5 xwid 62.0 yht 32.0)) ((= ntitle "A2_Portrait") (setq ht 554.0 wid 410.0 xpt 209.5 xwid 41.0 yht 23.0)) ((= ntitle "A3_Landscape") (setq ht 247.0 wid 400.0 xpt 200.0 xwid 41.0 yht 23.0)) ) So for multiple viewport the cond would use a "list" of values, title block then the viewport say lower left X,Y then upper right X,Y, repeat for how many viewports required. You could pick correct title block from a dcl radio button you can have around 20 in vertical dcl. If I am understanding correct post a true title block with say 3 viewports and will post some sample code,1 point
-
@ScottMC I don't recommend you put the OSMODE change in the CMDACTIVE loop. Here is how I would do it; tested this and it works perfectly. (defun c:C2 (/ cr el *error* fp oe os p p2) (defun *error* (msg) (if oe (setvar "cmdecho" oe)) (if os (setvar "osmode" os)) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ (strcat "\n" msg)) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (setq oe (getvar "cmdecho") os (getvar "osmode") ) (setvar "cmdecho" 0) (while (and (setvar 'osmode (boole 7 os 512)) (setq fp (getpoint "\nSpecify 1st Point of 2P.Circle: ")) ) (command "._Circle" "_2P" "_non" fp "_per");; Add "PER" to overide OSNAP here. (princ "\nSecond Point: ") (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) (setvar "osmode" os) (setq el (entget (entlast)) p (trans (cdr (assoc 10 el)) (cdr (assoc 210 el)) 1) p2 (getvar "lastpoint") cr (getvar "circlerad") ) (entdel (entlast)); Delete the Circle (princ (strcat "\n Coordinates: " (setq C2:pp ;; Global Variable "C2:pp" (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4) "," (rtos (caddr p) 2 4) ) ) "\n Diameter: " (rtos (* cr 2) 2 4) " | Radius: " (rtos cr 2 4) "\n" ) ) (entmakex (list (cons 0 "POINT") (cons 10 p))) (entmakex (list (cons 0 "POINT") (cons 10 p2))) (entmakex (list (cons 0 "CIRCLE") (assoc 10 el) (assoc 8 el) (assoc 40 el))) ; Recreate the Circle ) (setvar "cmdecho" oe) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) If you don't want PERP to be the only snap available, then try your method, but before the CMDACTIVE loop: (command ".circle" "2p" 1st) (setvar 'cmdecho 1) (setvar 'osmode (boole 7 (getvar 'osmode) 128)) ;; added 'perp (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\") )1 point
-
(defun rh:dxf (code lst) (cdr (assoc code lst))) (defun c:aa ( / cmde ent e_typ e_lst area vtx x_lst y_lst z_lst x_pt y_pt z_pt c_lst v_lst ss sum sz) (cond ( (/= 0 (getvar 'cmdecho)) (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) ) ) (while (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE,LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 3) (70 . 5) (-4 . "OR>") ) )) (setq ent (ssname ss 0) e_typ (rh:dxf 0 (setq e_lst (entget ent))) area (getpropertyvalue ent "area") v_lst nil ) (cond ( (= e_typ "POLYLINE") (setq ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) (while (/= "SEQEND" (cdr (assoc 0 (entget ent)))) (setq v_lst (cons vtx v_lst) ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) (if (= (setq sum (apply '+ (mapcar '(lambda (x) (caddr x)) v_lst))) 0.0) (setq z_pt 0.0) (setq z_pt (/ sum (length v_lst))) ) ) ( (= e_typ "LWPOLYLINE") (setq z_pt (rh:dxf 38 e_lst)) (foreach pr e_lst (if (= (car pr) 10) (setq v_lst (cons (cdr pr) v_lst))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) ) ) (setq c_lst (list x_pt y_pt z_pt)) (if(not sz) (progn (vla-getboundingbox (vlax-ename->vla-object ent) 'MinPT 'MaxPT) (setq p1 (vlax-safearray->list MinPT) p2 (vlax-safearray->list MaxPT)) (setvar 'textsize (* 0.05 (distance p1 p2))) (setq sz t) ) ) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 c_lst) (cons 40 (getvar 'textsize) ) (cons 71 5) (cons 72 5) (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m\U+00B2")) ) ) ) (if cmde (setvar 'cmdecho cmde)) )1 point
-
(defun rh:dxf (code lst) (cdr (assoc code lst))) (defun c:aa ( / cmde ent e_typ e_lst area vtx x_lst y_lst z_lst x_pt y_pt z_pt c_lst v_lst ss sum) (cond ( (/= 0 (getvar 'cmdecho)) (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) ) ) (while (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE,LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 3) (70 . 5) (-4 . "OR>") ) )) (setq ent (ssname ss 0) e_typ (rh:dxf 0 (setq e_lst (entget ent))) area (getpropertyvalue ent "area") v_lst nil ) (cond ( (= e_typ "POLYLINE") (setq ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) (while (/= "SEQEND" (cdr (assoc 0 (entget ent)))) (setq v_lst (cons vtx v_lst) ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) (if (= (setq sum (apply '+ (mapcar '(lambda (x) (caddr x)) v_lst))) 0.0) (setq z_pt 0.0) (setq z_pt (/ sum (length v_lst))) ) ) ( (= e_typ "LWPOLYLINE") (setq z_pt (rh:dxf 38 e_lst)) (foreach pr e_lst (if (= (car pr) 10) (setq v_lst (cons (cdr pr) v_lst))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) ) ) (setq c_lst (list x_pt y_pt z_pt)) (vla-getboundingbox (vlax-ename->vla-object ent) 'MinPT 'MaxPT) (setq p1 (vlax-safearray->list MinPT) p2 (vlax-safearray->list MaxPT)) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 c_lst) (cons 40 (* 0.02 (distance p1 p2)) );(getvar 'textsize)) (cons 71 5) (cons 72 5) (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m\U+00B2")) ) ) ) (if cmde (setvar 'cmdecho cmde)) )1 point
-
Are you saying you want say a A3 sheet 420x297 but with 3 viewports, that can be done. To have a oversize sheet does not make sense to me. You just set up the sheet details and the location of each viewport, not hard to do. ("A3" "0,20" "140,190" "140,20" ""280,190" and so on)1 point
-
Hi Steven, spot on! The LISP definitely flags raw geometry changes, not design intent. I actually use it as a "first pass" safety net. It's much faster to let the script cloud everything that moved and simply delete the few "false positives" (like lines stretched for spacing) than to manually hunt for actual design changes. For the overlapping issue: the clouds are standard polylines on a dedicated layer. You can easily grip-stretch them out of the way, or use DFCT beforehand to increase the padding so they draw looser. It doesn't replace a drafter's eye, but it definitely handles the heavy lifting of finding the changes first! Thanks for checking it out.1 point
-
NOTE: If your viewport frames do not match the paper size (for example: you put your borders in Paperspace and you only use the area internal to the border), Then use the area of the viewport frame to determine the size range, not the paper size.1 point
-
Are these the actual names of the Paper sizes in the pc3 file? The squares in your example file are just the paper sizes. You need to know the Frame layer, and the size range of the Frames that create your viewports. In any case - you should have all the information you need to do it yourself. as I said in the above to lay it out more clearly: 1) You need a range of AREA to be within on the frames. For example, on your "A4x3", (297 x 630) = 187110. Your range for the "square" variable should be a min and max with this value in the middle, such as 187110 - 10000 = 177110 "(> Square 177110)" and 187110 + 10000 = 197110 "(< Square 197110)" 2) each added condition should have the exact name of the Custom paper size: ((and (> Square 177110) (< Square 197110))(vla-put-ConfigName Layout "DWG To PDF.pc3")(vla-put-CanonicalMediaName Layout "_A4x3_(297.00_x_630.00_MM)")) ALSO: 3) You must have a unique Layer for the Frame polylines or blocks, something like "MyPaperSizeFrameLayer", or anything, as long as it is unique to the frames.1 point
-
The condition lines I added were just examples of how to add more sizes. As long as you know the areas and the name of the paper size, you should be able to add them. The "Square" variable as i understand it, is the min and max AREA of the frame you select (Length x Width), for the condition to select the paper size. This depends on what you are selecting for the frame to define the paper size. How would I know, if I don't have an example of what you are selecting?1 point
-
@Nikon While I don't know this routine, and don't recognize the Paper Sizes you have specified. The change would have to do with this section I think (see below). I added a couple condition lines for standard layouts "ISO full bleed 2A0" and "ISO full bleed 4A0" that are in my standard "DWG to PDF.PC3" file. I don't know what determines the area of the viewports though, (it seems that it is an object you select), so I am guessing at the area range of the viewport sizes. (cond ((and (> Square 59251) (< Square 65488)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A4_(297.00_x_210.00_MM)")) ((and (> Square 118503) (< Square 130977)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A3_(420.00_x_297.00_MM)")) ((and (> Square 237006) (< Square 261954)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A2_(594.00_x_420.00_MM)")) ((and (> Square 474012) (< Square 523908)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A1_(841.00_x_594.00_MM)")) ((and (> Square 948024) (< Square 1047816)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_A0_(841.00_x_1189.00_MM)")) ((and (> Square 1949898) (< Square 2049898)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_2A0_(1189.00_x_1682.00_MM)")) ((and (> Square 3949796) (< Square 4049796)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "ISO_full_bleed_4A0_(1682.00_x_2378.00_MM)")) (T (vla-put-ConfigName Layout "None")) ; Default to No plotter for non-standard sizes )1 point
-
hi. sorry to ask. Did you use Vibe coding on this? Coz I notice formatting similarities1 point
-
Hi everyone, I want to share a LISP tool I recently developed called SyncBlock. If you work with architectural or MEP backgrounds, you probably deal with this nightmare constantly: You have a Master Block (A), and several child blocks (B, C, D) that were copied from A but have some layers deleted to show different details. When the Master Block updates, synchronizing those child blocks without ruining their specific layer visibility—and without them flying off to random coordinates because their base points are all set to (0,0,0)—is a huge pain. To solve this, I wrote a script that does the following: 1. You select the Master Block. 2. You window-select the target blocks. 3. The script reads which layers are currently active in the target block, clears it, and pulls only those matching layers from the Master Block. The Magic (Consensus Voting Algorithm): The biggest challenge was alignment. Standard Bounding Box methods fail if you delete half a room or add a dimension in the child block. To fix this, the script uses a "Consensus Voting" approach. It gathers all valid geometry centers in both blocks, pairs them up, calculates the displacement vectors (dX, dY), and lets them "vote." The offset with the overwhelming majority wins. This ensures pixel-perfect alignment even if the child block is heavily trimmed! GitHub Repository: https://github.com/beastt1992/SyncBlock-AutoCAD The code avoids copying Hatches to prevent associativity crashes, and it safely handles older AutoCAD versions (like 2014) by using pure English prompts to avoid ANSI/UTF-8 encoding issues. I’d love for you guys to test it out on your messy real-world drawings! Any feedback, bug reports, or suggestions for improvement are highly appreciated. Cheers!1 point
-
I don't work with an architectural background so my nightmares are somewhat different than yours (most of them are about my mother in law or my sister in law) but thank you for sharing. High Lee , oh sorry , highly appreciated1 point
-
At one time P-F required students to submit a separate .dwg file for each plate. I don't see any reason why you can't use layouts. Your advisor could probably answer the question.1 point
-
Welcome to Cadtutor. What you are offering is not a new solutions this have been around for me say 17 years, for where I worked. But I have something extra for you, once you make the PDF's as single pdf's you can join them back into one, done this for 88 layouts but code looks for PDF's. It uses Ghostscript to rejoin the pdf's. Ghostscript is a free product and has lots of features. The code is ran via lisp. The code attached also allows for a selection of layouts it has the Ghostscript code in it. You will need to edit the version of Ghostscript and its location. A more advanced version checks for different company title blocks, eg landscape V's portrait. Like others I would push for using layouts a much better way as you can take advantage of the viewport scale, I have multi code for making multiple layouts at scale matching your model space. Multi GETVALS.lsp plotA3Pdfrange2.lsp1 point
-
@Steven P Not easy to notice, but he did give a link to the routine: https://github.com/beastt1992/autocad-batch-plot I agree that layouts should be used.1 point
-
So post the LISP so we can give feedback - it is easier to reference if the LISP is in the same thread as the comments and questions Though I might be tempted to say change the system and get the draughters to use paperspace for what it is meant for. (haven't had the paperspace / modespace discussion on here for a while now....)1 point
-
1 point
-
Yes - That's it! I looked at the drawing again, and the z dim was off by a very small amount! when I set z to zero on the entities - QLATTACH works.1 point
-
I wonder if their is a Z difference that those commands error. many a "2D" Drawing iv been given has stuff like 100' above everything else.1 point
-
@ScottMC I don't see the purpose of why you are cutting the circle, printing the coordinates to the command line, then pasting the circle in the same loop? - You don't need to initialize the pp variable as "" - There is not apparent reason to cut and paste the circle. - You do not need to put a Global variable into the registry to recall it again in the same session, even if the program stops. Try out the following code: (defun c:C2 (/ cr el *error* fp oe os p p2) (defun *error* (msg) (if oe (setvar "cmdecho" oe)) (if os (setvar "osmode" os)) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ (strcat "\n" msg)) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (setq oe (getvar "cmdecho") os (getvar "osmode") ) (setvar "cmdecho" 0) (while (and (setvar 'osmode (boole 7 os 512)) (setq fp (getpoint "\nSpecify 1st Point of 2P.Circle: ")) ) (command "._Circle" "_2P" "_non" fp) (setvar "osmode" OS) (princ "\nSecond Point: ") (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) (setq el (entget (entlast)) p (trans (cdr (assoc 10 el)) (cdr (assoc 210 el)) 1) p2 (getvar "lastpoint") cr (getvar "circlerad") ) (princ (strcat "\n Coordinates: " (setq C2:pp ;; Global Variable "C2:pp" (strcat (rtos (car p) 2 4) "," (rtos (cadr p) 2 4) "," (rtos (caddr p) 2 4) ) ) "\n Diameter: " (rtos (* cr 2) 2 4) "| Radius: " (rtos cr 2 4) "\n" ) ) (entmakex (list (cons 0 "POINT") (cons 10 p))) (entmakex (list (cons 0 "POINT") (cons 10 p2))) ) (setvar "cmdecho" oe) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) )1 point
-
I've been using already THANKS. I promise this might be my last change. Can you add +distsance just extend the last line that additional amount?1 point
-
I was using /# and /-# but using / and \ works to. if the 45 still going the wrong way you just need to flip the first two wcmatch calls. right now line 17 ((wcmatch inp "\\*") line 26 ((wcmatch inp "/*") fix line 17 ((wcmatch inp "/*") line 26 ((wcmatch inp "\\*") PolyHouse.lsp1 point
-
Was thinking that as well. would have to tinker with it for a bit. ended up adding an [U]ndo and [C]lose option. *can only use undo on last leg.1 point
-
1 point
-
Try this as a first pass, see if I have the idea right: Not quite as described and only draws lines as it is, rather than Polylines, but it being a Sunday and the CAD should be off it will do for a start, or if it inspires anyone tonight. To consider later: Fixing the loop - as it is just escape out of the LISP to end or join last point to start point. Join the lines together as Polylines (See Lee Mac PLJoin?) (defun c:testthis ( / Pta Ptb Pt1 Pt2 MyLine MyDistance MyAngle ed RefLine RefAngle ) (defun LM:roundm ( n m ) ;; Lee Mac ;; Round to nearest m (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) (command "line" pause pause "") ; Draw first segment (setq RefLine (entlast)) ; Line entitity name (setq Pta (setq Pt1 (cdr (assoc 10 (entget RefLine)))) ) ; First line start point (setq Ptb (setq Pt2 (cdr (assoc 11 (entget RefLine)))) ) ; first line end point (setq RefAngle (angle Pt1 Pt2) ) ; First line absolute angle (setq endloop "No") ; marker to keep loop going (while ; While loop (and (= endloop "No") ; Marker still 'no' (= (command "line" Pt2 pause "") nil) ; and user draws a line ) ; end and (setq ed (entget (entlast))) ; next segment entity name (setq Pt1 (cdr (assoc 10 ed))) ; next segment start point (also last one end point (Setq Pt1 Pt2) should also work (setq Pt2 (cdr (assoc 11 ed))) ; next segment end point (if (equal Pt2 Pta) ; If next segment end point = first segment start point (progn (princ "Closed Polyline") (setq Endloop "Yes") ; set end loop marker & end loop ) ; end progn (progn ; else (setq MyDistance (distance Pt1 Pt2)) ; Record next segment distance (setq MyAngle (LM:roundm (- (angle Pt1 Pt2) RefAngle) (/ pi 4) )) ; next segment angle relative to first segment, rounded to pi/4 (45 degrees) ; pi/4: 45 degree angles, pi/12 for 15 degrees (setq Pt2 (polar Pt1 (+ MyAngle RefAngle) MyDistance)) ; Calculate new PT from rounded angle (setq ed (subst (cons 11 Pt2) (assoc 11 ed) ed )) ; Modify the segment to perpendicular / 45 degree (entmod ed) ; update next segment ) ; end progn ) ; end if ) ; end loop (princ) ) ; end defun1 point
-
Alright, another Penn Foster student here. Big shocker there, I know. I put all my drawings from model space in to sheets but I lost all my dimensions and some of my furniture blocks. I double checked to be sure I didn't have any frozen layers, nothing is in def points, they're in correct layers, I ran an audit and it found and fixed 0 errors. I'm really new to all this auto cad stuff but apparently my work thinks I need it even though ill never use it. I'm not even ALOUD to have it on my computer at work...lol Any help would be greatly appreciated Flr-B.dwg Flr-1.dwg FLR-2.dwg1 point
-
The FAS format is the compiled version of an AutoLISP file, and one can guess that the programmer had a good reason to don’t provide his/her routine in plain code. If you really need to have access to that code, then I believe that is better to contact the programmer then to attempt to de-compile his/her work.1 point
