Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/07/2021 in all areas

  1. I use a template with all my setups, then command "PSETUPIN" to import. If you want to use lisp to add one it's as simple as this: (vla-add (vla-get-PlotConfigurations (vla-get-ActiveDocument (vlax-get-acad-object)))"TEST") But then you also have to set the appropriate properties ... IMO it's much easier to use a template.
    2 points
  2. Thanks @ronjonpand @mhupp@tombu!! I edit little bit of that code for my works. 1. delete ssget :S option for multi selection, add :L for except locked layer. 2. use object layer 3. leave exploded line. instead of original one. ; ronjonp http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 ; by ronjonp ; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford ; (load "AddArcTangents.lsp") AddArcTangents ; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents ; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 (defun c:pj (/ ss1) (setq varlist (list "cmdecho" "peditaccept") oldvars (mapcar 'getvar varlist) ) ;_ end setq (mapcar 'setvar varlist (list 0 1)) (setq ss1 (ssget)) (if (> (sslength ss1) 1) (progn (vl-cmdf "_pedit" "_M" ss1 "" "J" "0" "") (princ (strcat "\n" (itoa (sslength ss1)) " Lines Converted. ")) ) ;_ end progn (progn (vl-cmdf "_pedit" ss1 "") (princ (strcat "\n" (itoa (sslength ss1)) " Line Converted. ")) ) ;_ end progn ) ;_ end if (mapcar 'setvar varlist oldvars) (princ) ) ;_ end defun (defun c:AddArcTangents (/ _angle _line e ep p sp tmp objlay) (defun _angle (ename pt / ang clpt e param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq clpt (vlax-curve-getclosestpointto ename pt)) (setq param (vlax-curve-getparamatpoint ename clpt)) (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param))) ) ang ) ) (defun _line (p1 p2 layer) (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 8 layer) (cons 10 p1) (cons 11 p2) ) ) ) (if (ssget "_I") (setq SS (ssget "_:L" '((0 . "arc,lwpolyline")))) (progn (princ "\nSelect Arc or Polyline ") (setq SS (ssget "_:L" '((0 . "arc,lwpolyline")))) ) ) (if SS (foreach tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq e tmp EnTyp (cdr (assoc 0 (entget e))) ) (if (= EnTyp "LWPOLYLINE") (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)) (setq tmp (list (vlax-ename->vla-object e))) ) (foreach o tmp (if (= "AcDbArc" (vla-get-objectname o)) (progn (setq sp (vlax-curve-getstartpoint o)) (setq ep (vlax-curve-getendpoint o)) (setq objlay (vla-get-layer o)) (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil)) (_line sp p objlay) (_line ep p objlay) ;(if (= EnTyp "LWPOLYLINE") (vla-delete o) (vla-delete o) ;) ) ;(if (= EnTyp "LWPOLYLINE") (vla-delete o) ;(vla-delete o) ;) ) ) ) (Prompt "\nNo Arcs or Polylines Selected") ) (command "erase" SS "") (princ) ) so I get some of line what I want!! and then, just convert to polyline and join it as much as possible. thanks for your help
    2 points
  3. Above my coding knowledge once lambda & mapcar show up really need to sit down and learn those. I know at least @Tharwat can remember his password. maybe he will poke his head in here. (Se7en)
    2 points
  4. I output to about 5 page sizes and have Page Setups for both hard copies and PDF's for each of them. I'd recommend importing your Page Setups as you need them instead of recreating them. You could do it with a -PSETUPIN (Command) macro easily enough. As I create my drawings in Model Space to start it's easiest for me to import the layouts and Page Setups I need using Lee Mac's Lisp Steal from Drawing. This macro example copies an "11×17" Layout from my default qnew template along with two Page Setups "11×17" & "11×17 PDF" one for sending to a printer and the other for creating a PDF. ^C^C^P(Steal (strcat (vl-filename-directory (getenv "QnewTemplate")) (chr 92) "AutoCAD Template" (chr 92) "Templates.dwt") (list (list "Page Setups" (list "11×17" "11×17 PDF"))(list "Layouts" (list "11×17")))) My first two items in my Plot drop-down in the Ribbon are "Quick Plot current layout" & Quick Plot to PDF into drawing folder. Having all drawing output automated saves a lot of time.
    1 point
  5. I do this by then save as template .dwt already has title block inserted with multiple tabs. then you just have to use -layout & import from template.
    1 point
  6. 1 point
  7. Lots like me happy to do a custom lisp, but need beer money. Or have a go at adding layer to Lee's code. If you want to hve a go ssget the text create a list of layer name and text string remove duplicates and count This is the core bits to get what you want thanks to Gile. The lst5 is the result that is used in making a table. ; Make a count of common items ; By AlanH Aug 2021 (vl-load-com) ; By Gile (defun my-count (a L) (cond ((null L) 0) ((equal a (car L)) (+ 1 (my-count a (cdr L)))) (t (my-count a (cdr L)))) ) ; By Gile (defun remove_doubles (lst) (if lst (cons (car lst) (remove_doubles (vl-remove (car lst) lst))) ) ) (setq lst4(remove_doubles lstube)) (foreach val lst4 (setq cnt (my-count val lstube)) (setq lst5 (cons (list (/ cnt 2)(nth 0 val )(nth 1 val))lst5)) ) Yes I have something but would need to remove all the un necessary bits in the code.
    1 point
  8. Well you didn't save it then need to update to this. ; ronjonp http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 ; by ronjonp ; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford ; (load "AddArcTangents.lsp") AddArcTangents ; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents ; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 (defun c:AddArcTangents (/ _angle _line e ep p sp tmp) (defun _angle (ename pt / ang clpt e param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq clpt (vlax-curve-getclosestpointto ename pt)) (setq param (vlax-curve-getparamatpoint ename clpt)) (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param))) ) ang ) ) (defun _line (p1 p2 layer) (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 8 layer) (cons 10 p1) (cons 11 p2) ) ) ) (if (ssget "_I") (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline")))) (progn (princ "\nSelect Arc or Polyline ") (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline")))) ) ) (if SS (foreach tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq e tmp EnTyp (cdr (assoc 0 (entget e))) ) (if (= EnTyp "LWPOLYLINE") (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)) (setq tmp (list (vlax-ename->vla-object e))) ) ;(if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))) (foreach o tmp (if (= "AcDbArc" (vla-get-objectname o)) (progn (setq sp (vlax-curve-getstartpoint o)) (setq ep (vlax-curve-getendpoint o)) (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil)) (_line sp p "Intersection") (_line ep p "Intersection") (if (= EnTyp "LWPOLYLINE") (vla-delete o)) ) (if (= EnTyp "LWPOLYLINE") (vla-delete o)) ) ) ) (Prompt "\nNo Arcs or Polylines Selected") ) (princ) ) And yes @ronjonp is one of the 's
    1 point
  9. This lisp by ronjonp should do the trick: http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 I renamed the command as AddArcTangents and saved it as AddArcTangents.lsp then modified it to work with preselected objects as well including arcs & lwpolylines. Then added the macro ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents Named "Add Arc Tangents" with description "Add Tangent Lines to arc sections." to my "LWPline Object Menu" so I can add them simply by right-clicking on a lwpolyline and picking "Add Arc Tangents". ; by ronjonp ; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford ; (load "AddArcTangents.lsp") AddArcTangents ; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents ; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417 (defun c:AddArcTangents (/ _angle _line e ep p sp tmp) (defun _angle (ename pt / ang clpt e param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq clpt (vlax-curve-getclosestpointto ename pt)) (setq param (vlax-curve-getparamatpoint ename clpt)) (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param))) ) ang ) ) (defun _line (p1 p2 layer) (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 8 layer) (cons 10 p1) (cons 11 p2) ) ) ) (princ "\nSelect Arc or Polyline ") (setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline")))) (if tmp (progn (setq e (ssname tmp 0) EnTyp (cdr (assoc 0 (entget e))) ) (if (= EnTyp "LWPOLYLINE") (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)) (setq tmp (list (vlax-ename->vla-object e))) ) ; (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))) (foreach o tmp (if (= "AcDbArc" (vla-get-objectname o)) (progn (setq sp (vlax-curve-getstartpoint o)) (setq ep (vlax-curve-getendpoint o)) (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil)) (_line sp p "Intersection") (_line ep p "Intersection") (if (= EnTyp "LWPOLYLINE")(vla-delete o)) ) (if (= EnTyp "LWPOLYLINE")(vla-delete o)) ) ) ) ) (princ) ) I've collected a lot of code and snippets from him over the years. Thanks again ronjonp.
    1 point
  10. Helping you along here. Time for bed so i can't code. https://documentation.help/AutoCAD-DXF/WS1a9193826455f5ff18cb41610ec0a2e719-7a35.htm Arcs don't have start points and end points. They have start and end angles. To calculate those outer points you have to use the center point (10), radius (40), and start and end angles (50) (51) with the polar command. (setq arc (entget entity)) (setq cpt (cdr (assoc 10 arc) same for 40,50,51 (setq pt1 (polar cpt ang dist) ;this would get the white lines You would then have to then have to add or subtract 90° from 50 & 51 and use polar again. ;this would get the red lines. use lee mac's intersection with the acextendthisentity option. Now that I write all that looking at the picture it looks like you could just extend the line the length of the arc but prob have to do some type of math to get the real length.
    1 point
  11. Just use the MPEDIT (Express Tool) Join option with a Fuzz distance of 0.0001mm. They must be at the same elevation and coordinate system though. I'd probably use the FILLET (Command) if there's not to many of them.
    1 point
  12. Try this, note you will need to change the name of the output file to a directory that exists, it can be changed to say save to same location as dwg. (vl-load-com) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (defun c:t2csv ( / ss fname obj objstr txtins x ) (setq ss (ssget '((0 . "*TEXT")))) (if (/= ss nil) (progn (setq fname (open "D:\\acadtemp\\text2csv.txt" "W")) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq objstr (vla-get-textstring obj)) (setq txtins (vlax-get obj 'InsertionPoint)) (if (= (vla-get-objectname obj) "AcDbMText") (setq objstr (LM:UnFormat objstr nil)) ) (setq objstr (strcat (rtos (car txtins) 2 3) "," (rtos (cadr txtins) 2 3) "," (rtos (caddr txtins) 2 3) "," objstr)) (write-line objstr fname) (princ (strcat "\n" (rtos x 2 0))) ) (close fname) ) (alert "No text selected try again") ) (princ) )
    1 point
×
×
  • Create New...