Jump to content

Leaderboard

Popular Content

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

  1. Seems like a classic OSMODE problem. Try setting OSMODE to zero or use: (command "_.pline" "_non" pt1 "_non" ptt "_non" pt2 "")
    2 points
  2. (princ "\n Warning! Arc/Splines CL's Return Incorrect Length.\nSelect Centerlines to Construct Pipe: ") Replace the pnt10 pnt11 with a vla-get-length this way it handles plines with curves. Keep your ssgets as individuals then no need to reselect all the time. (setq ASS (ssget "X" (list (cons 0 "LINE") (cons 8 lay_name)) ) ) ;setq ASS As you make the offsets just add the new offset to a selection set SSADD then at end do 1 change Properties. (command "CHPROP" SSNEW1 "" "LAYER" "2" "") repeat for ssnew2 "15"
    1 point
  3. Have a button in excel to call/run commands in BricsCAD so you don't have to alt+tab all the time. VBA Code Sub PTEXT() On Error Resume Next Dim app As Object, Doc As Object On Error Resume Next Set app = GetObject(, "BricscadApp.AcadApplication") 'Checks if BricsCAD is open probably have to change for AutoCAD. If app Is Nothing Then MsgBox "BriscCAD isns't Open!", vbCritical, "Output Error" Exit Sub End If Set Doc = app.ActiveDocument Doc.SendCommand "PTEXT" & vbCr 'Lisp Command End Sub
    1 point
  4. The client only sees the end result. He doesn't have a clue that the company is continually doing it wrong. He won't care about that. Just as long as he receives his "deliverables" on time, and that the drawings correctly depict the product & its dimensions. (The client does not care that the drafters did not use correct drafting procedures.) Sad, but true.
    1 point
  5. @Juergen thanks for the note. I updated it to this code @mhupp that's good idea, but i think, if we modify the cell with the text attribute, there is likely to be a problem when using formulas such as vlookup like above gif. in this case we need one more process or evaluate.. if we add ' in front of a cell, we can get a text-like property, and we can use a formula right away, and we can also calculate when it is a number. but someone may like it that way, so i attached version 2 in here without modification of the original ; CTEXT & PTEXT ver.2 - 2022.07.11 exceed ; step 0 - In Excel's options, you need to set to allow 'vba macros' so that autolisp can control Excel. ; 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 ; ; updates ; - address calculation of ex:ECSELPUT snippet was modified by Gilles Chanteau's awsome calculation method. The code is more concise. ; - for support the expression of exponents or starting with 0, ; ' is added in front of the input in Excel. This is excluded when doing PTEXT. (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 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) (strcat "'" (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) ;(princ ss1stacklist) (repeat (- (/ ss1count 3) 1) (setq enametoedit (handent (cadr (nth index2 ss1stacklist)))) (setq newtexttoedit (substr (vl-princ-to-string (cadr (nth (+ index2 2) ss1stacklist))) 1)) (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 / tc addr rng textstring2 ) (setq tc (Number2Alpha c)) (setq addr (strcat tc (itoa r) ":" tc (itoa r))) (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) ) ) ;------------------------------------------------------------------------------- ; Number2Alpha - Converts Number into Alpha string ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Num# = Number to convert ; Syntax example: (Number2Alpha 731) = "ABC" ;------------------------------------------------------------------------------- (defun Number2Alpha (Num# / Val#) (if (< Num# 27) (chr (+ 64 Num#)) (if (= 0 (setq Val# (rem Num# 26))) (strcat (Number2Alpha (1- (/ Num# 26))) "Z") (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#))) ) ) );defun Number2Alpha for more upgrade, it will be faster to make a list and paste it at once instead of entering the cell one-by-one in the CTEXT process. I'm also working on weekends because my busy work that made this happen is still going on.
    1 point
  6. I think the way my boss's lisp gets around this is that it formats the cell as text instead of general --edit This also helps with leading 0's
    1 point
  7. Hi exceed, there is one more note. Excel changes the value if E is in the reference. e.g. Reference = 759e2 becomes 7.59E+04. Is it possible that an apostrophe is written before the reference number? (handle: '759e2) So Excel does not convert to scientific. (exponential) Thanks.
    1 point
  8. I would find a new company ASAP, unless they paid an exceptional salary! I use 3D all of the time in AutoCAD, I have used Inventor, Pro E and Solidworks some as well and always did 3D.
    1 point
  9. Not sure, too busy to check right now, but it might do it...and if it does you'll be a happy camper.
    1 point
  10. That was it, thank you! For some reason I thought that by not writing e.g. "near" no object snap would occur, but I forgot I have OSNAP on by default.
    1 point
  11. in this line (setq filter '((0 . "INSERT"))) (setq pre_blk (ssget "_X" (list '(-4 . "=,=,=") (cons '10 pre_vtx) filter))) (setq post_blk (ssget "_X" (list '(-4 . "=,=,=") (cons '10 post_vtx) filter))) 1. do not mix " '(( " and " (list (cons ", it's better to know. you can convert that (setq filter (list (cons 0 "INSERT"))) 2. so after convert, you can see that (list (cons 0 "INSERT")) is already in the list. in example, when you use ssget (ssget "_X" '((0 . "INSERT"))) is correct. but your example has (ssget "_X" (list ~~ '((0 . "INSERT")))) if you want to add filter option. you can play in that () like this (ssget "_X" (list (cons 0 ~~) (cons 8 ~~) (cons 10 ~~))) 3. (cons '10 -> (cons 10
    1 point
  12. Since your using :S with ssget just switched them over to entsel opted not to extend either object to get intersections. please change to meat your needs. (defun c:selectblocks (/ obj1 obj2 pnt poly p_param pre_vtx pre_blk post_vtx post_blk incr) (if (and (setq obj1 (car (entsel "\nSelect Line: "))) (setq obj2 (car (entsel "\nSelect Polyline: ")))) (foreach pnt (LM:intersections (vlax-ename->vla-object obj1) (vlax-ename->vla-object obj2) acextendnone) ;Do not extend either object ;; get the next vertices relative to the intersection point ;; thanks to dlanorh (https://www.cadtutor.net/forum/topic/68855-vertices-of-polyline-near-a-point/) (setq poly (vlax-ename->vla-object obj2) p_param (vlax-curve-getparamatpoint poly pnt) pre_vtx (vlax-curve-getpointatparam poly (fix p_param)) ;gets the coords of the vertex before post_vtx (vlax-curve-getpointatparam poly (1+ (fix p_param))) ;the coords of the vertex after ) ;;if selection fails, try fence selection: (if (not (setq pre_blk (ssget "_X" (list '(0 . "INSERT") (cons 10 pre_vtx))))) (progn (setq incr (list (mapcar '+ pre_vtx '(1 0 0)) (mapcar '- pre_vtx '(1 0 0)))) ;extend fence in both directions (setq pre_blk (ssget "_F" incr '((0 . "INSERT")))) ) ) (if (not (setq post_blk (ssget "_X" (list '(0 . "INSERT") (cons 10 post_vtx))))) (progn (setq incr (list (mapcar '+ post_vtx '(1 0 0)) (mapcar '- post_vtx '(1 0 0)))) ;extend fence in both directions (setq post_blk (ssget "_F" incr '((0 . "INSERT")))) ) ) ) ) ) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) )
    1 point
  13. Thanks for the info! It work perfect!!
    1 point
  14. Hi exceed, nice lisp. When I write ptext AutoCad Error: no function definition: LM:STR->LST What´s wrong? thanks
    1 point
  15. Hello @exceed Lisp error Command: CTEXT Error: no function definition: EX:ESMAK thanks
    1 point
×
×
  • Create New...