Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/11/2023 in all areas

  1. When the LISPs do not run, are there any error messages in the command line, does it always happen to the same drawing (or will closing, opening and trying again on the drawing make it work for example) "This does not work" doesn't really help you see
    1 point
  2. You could Google LinOut.lsp.
    1 point
  3. You might be right, but either way, without visibility of the implementation, I personally don't rely on the order of layouts returned by (layoutlist).
    1 point
  4. Have you tried the JOIN command? It will connect all the selected lines/polylines, if it can. Whether the resulting polyline is closed depends on the topology. As far as I know, there is no command to automatically close gaps because there are too many variables. Another reason polylines won't close is elevation differences. Make sure all your objects are at elevation 0 (or whatever you're using).
    1 point
  5. Magic, I'm starting to understand it a bit more - thanks again Steven!!
    1 point
  6. The above codes don't work for me. I wrote my version. coor_vert.LSP
    1 point
  7. I think I'll give you some hints and reckon you can work it out from there? Somewhere near the beginning of the LISP you want to ask what to call the table, perhaps after you have selected all the numbers, so here is a function in there, unstable (yes, I know...), and after the line (defun unstable ( ....... )) you want to ask the user for the title? Perhaps as the 2ns or 3rd line of code, something like that. (setq TableTitle (getstring "Enter Table Title" T)) should do the trick. The T at the end allows the user to enter spaces (usually pressing 'space' acts the same as enter, T prevents this. Also add your variable name in the (defun line to localise it (so that it's value doesn't 'leak' into other LISPs if they use the same variable name: (defun UnsTable ( refs / ss name ref insPt table row acounter MyColumns TableTitle) Next pop this variable into the table. In your LISP you will have a line I'd search for "DRILLING" to get to it quickly. Probably very similar to the example above where I used "HOLES" (vla-setText table 0 0 "Holes") ; table title ; set in column 0, row 0 (LISP count from as the first number) replace the test string here with the variable you got earlier. Remember that the text string will have " " either side, a variable wont: (vla-setText table 0 0 TableTitle) ; table title ; set in column 0, row 0 (LISP count from as the first number) That should do it
    1 point
  8. That works perfectly! I cannot ask for anything more... well one thing.... (just kidding!) I cannot THANK YOU enough!!! That is some incredible code (to me) Thank you very much Sir!
    1 point
  9. @RepCad I have this for the definition points of LINE,MLINE,POLYLINE,POINT,ARC,CIRCLE,ELLIPSE or INSERT. If some placements are incorrect it is easy to redirect them with the grips (vl-load-com) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun make_lead (pt / obj ptlst arr nw_obj) (setq obj (entlast) ptlst (append pt (polar pt o_lead d_lead)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "\\fArial|b0|i0|c0|p34;X = " (rtos (car pt) 2 3) "\\PY = " (rtos (cadr pt) 2 3))) (vla-put-layer nw_obj "Id-XY") (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-DoglegLength nw_obj (getvar "TEXTSIZE")) (vla-put-LandingGap nw_obj (getvar "TEXTSIZE")) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car (getvar "VIEWCTR")) (car pt_lead)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) ) (defun c:ptdef-xy2lead ( / js htx rtx rtx0 pt_lead d_lead o_lead AcDoc Space dxf_cod n lremov ent ename l_pt l_pr) (princ "\nSelect an object for filtering model: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "LINE,MLINE,*POLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't an availaible object for this function!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive field height <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nGive field orientation <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx)) (initget 1) (setq pt_lead (getpoint (getvar "VIEWCTR") "\nGive general orientation and distance for guide: ")) (setq d_lead (distance (getvar "VIEWCTR") pt_lead)) (setq o_lead (angle (getvar "VIEWCTR") pt_lead)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "LAYER" "Id-XY")) (vlax-put (vla-add (vla-get-layers AcDoc) "Id-XY") 'color 174) ) ) (setq dxf_cod (entget (ssname js 0))) (initget "Single Multiple") (if (eq (getkword "\nSelection filtering [Single/Multiple]<M>: ") "Single") (setq n -1) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) n -1 ) ) (repeat (sslength js) (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil) (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints)) (foreach n l_pr (if (vlax-property-available-p ename n) (setq l_pt (if (eq n 'Coordinates) (progn (append (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (l-coor2l-pt (vlax-get ename n) nil) (l-coor2l-pt (vlax-get ename n) T) ) l_pt ) ) (cons (vlax-get ename n) l_pt) ) ) ) ) (mapcar 'make_lead l_pt) ) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) )
    1 point
  10. The other (getvar 'dwgname) this will always be with .dwg and (vl-filename-base (getvar 'dwgname)) no dwg.
    1 point
  11. I have a really old routine that will add & subtract object values, but I was inspired by this thread to write a new one. Allows user to combine [Add, Divide, Multiply, Subtract] values of selected objects. User can also change mode (Add, Divide, Multiply, Subtract) at any time. When finished, user is prompted for placement point of MText with final value. If only Add option used, user has option to average values. Accepted: Attribute, Civil 3D Point, Land Desktop Point, MText, MultiLeader, Text or typed value. Call with CombineValues or AV. Your comments/criticism are greatly appreciated. Enjoy. ;;; ------------------------------------------------------------------------ ;;; CombineValues.lsp v1.2 ;;; ;;; Copyright© 04.09.10 ;;; Alan J. Thompson (alanjt) ;;; ;;; Contact: alanjt @ TheSwamp.org, CADTutor.net ;;; ;;; Permission to use, copy, modify, and distribute this software ;;; for any purpose and without fee is hereby granted, provided ;;; that the above copyright notice appears in all copies and ;;; that both that copyright notice and the limited warranty and ;;; restricted rights notice below appear in all supporting ;;; documentation. ;;; ;;; The following program(s) are provided "as is" and with all faults. ;;; Alan J. Thompson DOES NOT warrant that the operation of the program(s) ;;; will be uninterrupted and/or error free. ;;; ;;; Allows user to combine extracted numerical values of selected Attribute, ;;; Civil 3D Point, Land Desktop Point, MText, MultiLeader, Text or typed value. ;;; ;;; Combine options include: Add, Divide, Multiply, Subtract (can be changed at any time). ;;; If user only adds values, an option to average is available. ;;; Upon completion, user is prompted to specify placement point MText with final value. ;;; ;;; Revision History: ;;; ;;; v1.1 (04.11.10) 1. Updated subroutine: AT:ExtractNumbers ;;; ;;; v1.2 (04.13.10) 1. Reworked AT:ExtractNumbers subroutine. ;;; 2. Added subroutine AT:ListSelect to select numbers when multiple exist in string. ;;; 3. If multiple numbers exist in string, user is prompted with list box ;;; to select each desired number. If multiple numbers are selected, they are ;;; combined and added to display. ;;; 4. Added CV:StripFormat subroutine, as taken from StripMText 5.0b, ;;; Copyright© Steve Doman and Joe Burke 2010 (with permission), to avoid any ;;; issues with extracting numbers out text formatting. (Thank you Joe & Steve) ;;; ;;; ------------------------------------------------------------------------ CombineValues.LSP
    1 point
  12. Try the following: ;; Ungroup Multiple - Lee Mac (defun c:ungroupm ( / idx grp sel ) (if (setq sel (ssget)) (repeat (setq idx (sslength sel)) (if (= "GROUP" (cdr (assoc 0 (entget (setq grp (cdr (assoc 330 (entget (ssname sel (setq idx (1- idx))))))))))) (entdel grp) ) ) ) (princ) )
    1 point
  13. (defun C:STM (/ cpent elist en ip newtxt pt ss sum sumtxt txt) (princ "\n\t\t>>> Select text to get summ >>>") (if ;;select texts/mtexts on screen : (setq ss (ssget '((0 . "*TEXT")))) ;; if selected then : (progn ;; store the first text entity for using 'em further : (setq cpent (ssname ss 0)) ;; set initial sum to zero : (setq sum 1) ;; loop trough selected texts/mtexts : (while ;; get the first text in selection : (setq en (ssname ss 0)) ;; get entity list of them : (setq elist (entget en)) ;; get the textstring by key 1 from entity list : (setq txt (cdr (assoc 1 elist))) ;; create output string : (setq sumtxt ;; concatenate strings : (strcat ;; convert digits to string : (rtos ;; add to summ the digital value of text : (setq sum (* (atof txt) sum)) ;; 2 is for metric units (3 for engineering) : 2 ;; set precision by current : (getvar "dimdec"))) ) ;; delete entity from selection set : (ssdel en ss) ) ;; display message in the command line: (princ (strcat "\nSumm=" sumtxt)) (setq pt (getpoint "\nSpecify the new text location: ")) ;; get the insertion point of stored entity : (setq ip (cdr (assoc 10 (entget cpent)))) ;; copy text entity to the new destination point : (command "_copy" cpent "" ip pt) ;; get the last created entity : (setq newtxt (entlast)) ;; get entity list of them : (setq elist (entget newtxt)) ;; modify entity list with new text string : (entmod (subst (cons 1 sumtxt)(assoc 1 elist) elist)) ;; update changes : (entupd newtxt) ) ) (princ) ) (princ "\nStart command with STM") (princ)
    1 point
×
×
  • Create New...