Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/16/2024 in all areas

  1. Nice idea! A small improvement though. You want to remove all list items from ssnamex before processing. That is in case the items are selected with a box or lasso, which is information that ssnamex returns as well. ;; Performs a function on all items in a selection set. (defun mapss (ss func) (mapcar func (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)) ) ) )
    2 points
  2. Yes, it's possible: (defun c:foo ( / pl pm) (and (setq pl (entsel "\nSelect polyline <exit>: ")) (progn (setq pm (vlax-curve-getParamAtPoint (car pl) (vlax-curve-getClosestPointTo (car pl) (trans (cadr pl) 1 0)))) (princ (list (vlax-curve-getpointatparam (car pl) (fix pm)) (vlax-curve-getpointatparam (car pl) (1+ (fix pm))) ) ) ) ) (princ) )
    2 points
  3. Above code tidied up and a slight change (defun c:ac1 ( / entname1 ent2name obj1 ent3name ) (setq ent1name (car (entsel "\nSelect region 1: "))) ;;Select region 1. Maybe use ss get with single selection & region filters (setq ent2name (car (entsel "\nSelect region 2: "))) ;;Select region 2. Maybe use ss get with single selection & region filters (setq ent3name (entmakex (entget ent1name))) ;;Copy region 1 (setq ent4name (entmakex (entget ent2name))) ;;copy region 2 (command "union" ent3name ent4name "") ;;Union Regions (setq obj3 (vlax-ename->vla-object ent3name)) ;;VLA- object name for region 1 copy (setq ent3area (rtos (vla-get-area obj3) 2 3)) ;;Area of 2 regions (redraw ent3name 3) ;;Highlight selected areas (getstring (strcat "\nArea: " ent3area ". Press Enter") ) (redraw ent3name 4) ;;Remove highlights (entdel ent3name) ;;Delete unioned area (princ) ;;Exit quietly )
    2 points
  4. Understood - thanks for the explanation! That makes perfect sense.
    1 point
  5. You're correct, they are gcode for CNC milling, the extensions will be different, but I'll be linking this to an existing program I wrote a while back.(Which is a dcl file also). A bit of extra info What I have is a cam software that writes these files, in a few different formats for different machines. The text I've highlighted to be removed is useful for one machine only, and can cause issues on the other 2, so I've been manually deleting the lines each time I output gcodes.my existing program uses the cad filename& a dcl with radio buttons to chose a suffix from a list of 8, renames the filenames to add the suffix to each (for file archiving reasons), so I can pass the file names and file location as one concatenated variable, and the keywords would stay the same, as that part of the code is the same in each of the filetypes, only some of the numbers between the keywords can change. The amount of time this can save me is quite a bit daily, but it's more the tediousness of manually doing it thats behind the request. I hope this makes sense, and sheds some light on what I'm trying to achieve ?
    1 point
  6. @Mr Bojangles Here is a better example that includes a dialog box to select the file. You can change the command name and strings as stated in the comments to suit you needs. NOTE: in the path string, backslashes between folders have to be doubled "\\". Are these G-code files? I put the extension "gco" on the file dialog, but yours might use "g", "nc" or something else? ;; Change the command name to suit ;; Change the "C:\\Myfolder" path to whatever your files are located. ;; Change the "gco" (G code) file extension to whatever you are using (defun c:STRIPGC () (if (setq fil (getfiled "Select File to Strip" "C:\\Myfolder\\" "gco" 4)) (StripTextAtKwords fil "; Main Program Start" "; End Topcut") ) ) ;; Strips an ASCI text file of any lines between to keyword lines. (defun StripTextAtKwords (file kw1 kw2 / flg fp ln ls n) (if (and file (setq file (findfile file))) (progn (setq fp (open file "r") flg nil) (while (setq ln (read-line fp)) (if (= ln kw1)(setq flg T ls (cons ln ls))) (if (= ln kw2)(setq flg nil)) (if (not flg)(setq ls (cons ln ls))) ) (close fp) (if ls (progn (setq fp (open file "w") ls (reverse ls) n 0 ) (repeat (length ls) (write-line (nth n ls) fp) (setq n (1+ n)) ) (close fp) (princ "\nFile Updated.") ) ) ) (princ "\nFile Not found.") ) (princ) )
    1 point
  7. AHH I never thought to check with all of the keywords... Just assumed it would only work for just the single work, which is why I did a test with just one Face palm moment... I'll give it another try, but i guess if it works for you it will for me also. I'm very grateful for your time and effort looking at this for me
    1 point
  8. @Mr Bojangles It seems to work fine for me if the correct keywords are supplied. As long as the strings for kw1 and kw2 match the whole line: (defun c:test () (StripTextAtKwords "keywords.txt" "; Main Program Start" "; End Topcut") ) Results: #XZERO! = SD.USR.Allign.XPosActWPZP 1 #YZERO! = SD.USR.Allign.YPosActWPZP 1 IF (SD.ROTO.Batch=FALSE) THEN G1 G53 G153 G90 S90000 F30000 M3 G8 G17 G40 G47 G71 FFW(1) JKC(1) CLN(1) CLN(CollErr0) CLN(DLA4) M991 G1 Z50. F30000 ED1 1 ENDIF LP 8329025(0, 0, 0, 0) 1 IF (SD.ROTO.Batch=FALSE) THEN MIR(0) ROT(0) G153 G1 Z50 F30000 X[#XPLATE!] Y[#YPLATE!] M992 N10 ;***** END OF PROGRAM ***** 1 ENDIF M30 LPS 8329025 ; P1 X Offset ; P2 Y Offset ; P3 Rotation Angle ; P4 Operation to run in batch mode or all if 0 1 XOFFSET!=P1! : YOFFSET!=P2! : ROTANG!=P3! : OPERATION%=P4% 1 IF (SD.ROTO.Batch=TRUE) AND (OPERATION%=0) THEN 1 OPERATION%=SD.ROTO.BatchOperation 1 XOFFSET!=SD.ROTO.BatchXOffset 1 YOFFSET!=SD.ROTO.BatchYOffset 1 ROTANG!=SD.ROTO.BatchRotationOffset 1 ENDIF ; Plate TPH After Finishing 1 #DIEHEIGHT!=0.458 ; Programmed Z-Depth 1 #ZDEPTH!=-0.233 1 #ZZERO! = #DIEHEIGHT!+SD.ROTO.TableHeightAdjust 1 #XPLATE! = #XZERO!-XOFFSET!*COS(SD.USR.Allign.ResAngle)-YOFFSET!*SIN(SD.USR.Allign.ResAngle) 1 #YPLATE! = #YZERO!+YOFFSET!*COS(SD.USR.Allign.ResAngle)-XOFFSET!*SIN(SD.USR.Allign.ResAngle) 1 #RPLATE! = ROTANG!+SD.USR.Allign.ResAngle 1 PMT("PSI",154,1)=0 ; Main Program Start ; End Topcut 1 ENDIF 1 IF (OPERATION%=2) OR (OPERATION%=0) THEN ; Finishing 1 #FEEDRATE = 1417 LP TlChange LP Qualify(1.000,0.0,0.0) ; Qualify Sharp LP STP9025(521, 1, 90) LP TlChange LP Qualify(1.000,0.0,0.0) ; Qualify Sharp LP STP9025(521, 91, 180) ; End Finishing 1 ENDIF PEND ; End Subrouti
    1 point
  9. only real time is use entlast is in instances like @Steven P said or when i have to build a selection set after modifying/creating a bunch of stuff inside a lisp and don't want to prompt the user to select them again. (setq SS (ssadd)) ;how to create a blank selection set (setq LastEnt (entlast)) ;set right before you create objects. you want to either add to a selection set or track while in a lisp (while (setq LastEnt (entnext LastEnt)) ;after entities are created this will add them to a selection set. (ssadd EntLst SS) ;a blank selection set or existing selection set is needed. )
    1 point
  10. got a job and half converting that from common lisp to autolisp, cheers ill have a look
    1 point
  11. im using WGS84 constants i believe (https://www.jpz.se/Html_filer/wgs_84.html), ive tried OSGB ones but the values change very little but still the same issue with it overdoing the result i had a working java code ill try find when i get home which didnt work in javascript. yeah im looking to do the same thing, messing around with converting KML files into bricscad for convenience aswell as a few otherthings
    1 point
  12. This is how I process a selection set. will generate a list of entity names for the selection (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;code here will repeat for each each entity name in list ) A few years ago stumbled across what pkenewell posted to instead make a vla-object list (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;code here will repeat for each each vla-object name in list ) ent and obj don't need to be declared since they are only temp while in the foreach loop. -edit @dexus The (vl-remove-if 'listp is to remove the point or points used when making the selection set this isn't needed when ssget with "_X" option is used. Since a pick point isn't generated for those selection sets.
    1 point
  13. revisiting this after a while, i stumbled across some code which ive converted into autolisp (defun LatLongToEastNorth (latitude longitude / a b F0 lat0 lon0 N0 E0 e2 n n2 n3 cosLat sinLat nu rho eta2 Ma Mb Mc Md M cos3lat cos5lat tan2lat tan4lat I II III IIIA IV V VI dLon dLon2 dLon3 dLon4 dLon5 dLon6 N E) (setq latitude (deg2rad latitude) longitude (deg2rad longitude) a 6377563.396 b 6356256.910 F0 0.9996012717 lat0 (deg2rad 49) lon0 (deg2rad -2) N0 -100000 E0 400000 e2 (- 1 (/ (* b b) (* a a))) n (/ (- a b) (+ a b)) n2 (* n n) n3 (* n n n) cosLat (cos latitude) sinLat (sin latitude) nu (* a F0 (sqrt (- 1 (* e2 (* sinLat sinLat))))) rho (* a F0 (- 1 e2) (expt (- 1 (* e2 (* sinLat sinLat))) 1.5)) eta2 (/ nu rho 1.0) Ma (* (+ 1 n (* (/ 5 4) n2) (* (/ 5 4) n3)) (- latitude lat0)) Mb (* (+ (* 3 n) (* 3 n n) (* (/ 21 8) n3)) (sin (- latitude lat0)) (cos (+ latitude lat0))) Mc (* (+ (* (/ 15 8) n2) (* (/ 15 8) n3)) (sin (* 2 (- latitude lat0))) (cos (* 2 (+ latitude lat0)))) Md (* (* (/ 35 24) n3) (sin (* 3 (- latitude lat0))) (cos (* 3 (+ latitude lat0)))) M (* b F0 (- Ma Mb Mc Md)) cos3lat (* cosLat cosLat cosLat) cos5lat (* cos3lat (* cosLat cosLat)) tan2lat (* (tan latitude) (tan latitude)) tan4lat (* tan2lat tan2lat) I (+ M N0) II (* (/ nu 2) sinLat cosLat) III (* (/ nu 24) sinLat cos3lat (- 5 tan2lat (* 9 eta2))) IIIA (* (/ nu 720) sinLat cos5lat (- 61 (* 58 tan2lat) tan4lat)) IV (* nu cosLat) V (* (/ nu 6) cos3lat (/ nu rho) (- tan2lat)) VI (* (/ nu 120) cos5lat (- 5 (* 18 tan2lat) tan4lat (* 14 eta2) (* 58 tan2lat eta2))) dLon (- longitude lon0) dLon2 (* dLon dLon) dLon3 (* dLon2 dLon) dLon4 (* dLon3 dLon) dLon5 (* dLon4 dLon) dLon6 (* dLon5 dLon) N (+ I (* II dLon2) (* III dLon4) (* IIIA dLon6)) E (+ E0 (* IV dLon) (* V dLon3) (* VI dLon5))) (list E N) (princ E) (princ " ") (princ N) (princ " ") ) (defun deg2rad (degrees) (* degrees (/ pi 180)) ) (defun C:longlat () (LatLongToEastNorth 51.500622 -0.12685776) (princ) ) its returning kinda accurate but not accurate enough, the above code would return: 529460, 179679 but what i should actually be getting is 530113, 179628 (i used grid reference finder to get these converted) I'm not sure if it could be lisp itself, because I''ve seen different code (js, C & Java) produce different results from its math library I understand there are different 3rd party applications to convert this but I'm trying to create my own script to give me more flexibility with it, and move away for the API I'm currently using
    1 point
  14. Yes perfect! I started thinking and remembered that (ssnamex) doesn't always return the same list info last night and was planning to revisit this today. Good catch!
    1 point
  15. OP, have you tested the code I provided here : https://www.cadtutor.net/forum/topic/85374-why-would-entlast-not-be-getting-the-unioned-entity-in-this-code/?do=findComment&comment=640320 It seems that you avoid my inputs... It should do what should, as I also avoided (entlast)...
    1 point
  16. Hi Steven, your solution is posible. if i use different bolts they have there own name. if i scale a block they have the same name. moost of the time you need a correct count of bolts in a drawing.
    1 point
  17. Please try the following untested program and you need to revise the tag string to suit yours as I mentioned earlier. NOTE: you can enable the system variable DYNMODE and set it to 1 if you would like to have a drop down menu to pick a certain block name from the list. (defun c:Test (/ sel int ent att spc bkn) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (or *bkn* (setq *bkn* "HPO-Standard-Text")) (and (or (initget 6 "HPO-Standard-Text HPO-Small-Text DP-Standard-Text DP-Small-Text") (setq *bkn* (cond ((getkword (strcat "\nSpecify block name [HPO-Standard-Text , HPO-Small-Text , DP-Standard-Text , DP-Small-Text] < " *bkn* " > : " ) ) ) (*bkn*) ) ) ) (or (tblsearch "BLOCK" (setq bkn (vl-string-translate "-" " " *bkn*))) (alert (strcat "Attributed Block < " bkn " > was not found in drawing <!>" ) ) ) (princ "\nSelect Mtexts to be replaced with Attributed Block :") (setq sel (ssget "_:L" '((0 . "MTEXT")))) (setq spc (vlax-get (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))) 'block ) ) (repeat (setq int (sslength sel)) (setq ent (ssname sel (setq int (1- int)))) (and (setq att (vla-insertblock spc (vlax-3d-point (cdr (assoc 10 (entget ent)))) bkn 1.0 1.0 1.0 0. ) ) (vl-some '(lambda (x) (if (eq (strcase (vla-get-tagstring x)) "ROOMNO") ;; change the tag name "ROOMNO" to suit yours (progn (vla-put-textstring x (unformatmtext (cdr (assoc 1 (entget ent)))) ) t ) ) ) (vlax-invoke att 'getattributes) ) (entdel ent) ) ) ) (princ) ) (vl-load-com) ;; ;; (defun unformatmtext (string / text str) ;; ASMI - sub-function ;; ;; Get string from Formatted Mtext string ;; (setq text "") (while (/= string "") (cond ((wcmatch (strcase (setq str (substr string 1 2))) "\\[\\{}`~]" ) (setq string (substr string 3) text (strcat text str) ) ) ((wcmatch (substr string 1 1) "[{}]") (setq string (substr string 2)) ) ((and (wcmatch (strcase (substr string 1 2)) "\\P") (/= (substr string 3 1) " ") ) (setq string (substr string 3) text (strcat text " ") ) ) ((wcmatch (strcase (substr string 1 2)) "\\[LOP]") (setq string (substr string 3)) ) ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]") (setq string (substr string (+ 2 (vl-string-search ";" string)) ) ) ) ((wcmatch (strcase (substr string 1 2)) "\\S") (setq str (substr string 3 (- (vl-string-search ";" string) 2)) text (strcat text (vl-string-translate "#^\\" " " str)) string (substr string (+ 4 (strlen str))) ) (print str) ) (t (setq text (strcat text (substr string 1 1)) string (substr string 2) ) ) ) ) text ) ;; ;;
    1 point
  18. Yes, that's right. I try to avoid entlast if I can unless it is in the line straight after I have created an entity.
    1 point
  19. OHHHH, so when i (command "union" ent3name ent4name ""), the first entity name listed after "union" (in this case ent3name) remains the entity name for the newly unioned region? If that's correct this is exactly what i was getting messed up on. Thankyou so much.
    1 point
  20. This can be a start ? (vl-load-com) (defun add_vtx (obj add_pt ent_name / sw ew nw bulg) (vla-GetWidth obj (fix add_pt) 'sw 'ew) (vla-addVertex obj (1+ (fix add_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) ) ) ) ) (setq nw (* (/ (- ew sw) (- (vlax-curve-getdistatparam obj (1+ (fix add_pt))) (vlax-curve-getdistatparam obj (fix add_pt))) ) (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt))) ) bulg (atan (vla-GetBulge obj (fix add_pt))) ) (vla-SetBulge obj (fix add_pt) (/ (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25)) (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) ) ) (vla-SetWidth obj (fix add_pt) sw (+ nw sw) ) (vla-SetWidth obj (1+ (fix add_pt)) (+ nw sw) ew ) (vla-update obj) ) (defun c:NTT ( / ss AcDoc Space len lap n ename obj dxf_10 p1 p2 p_mid brk1 brk2 lst_brk dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 lst_tmp where count ltmp e_last nw_pt) (princ "\nSelect polyline") (setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4) (70 . 0)))) (cond (ss (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) (initget 6) (setq len (getdist "\nEnter cut length? <11700>: ")) (if (not len) (setq len 11700.0)) (initget 6) (setq lap (getdist "\nEnter lap length? <1000>: ")) (if (not lap) (setq lap 1000.0)) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ename) dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ename))) p1 (vlax-curve-getPointAtParam ename 1) p2 (vlax-curve-getPointAtParam ename 2) ) (cond ((> (distance p1 p2) len) (setq p_mid (vlax-curve-getPointAtParam ename 1.5) brk1 (polar p_mid (angle p_mid p1) (* len 0.5)) brk2 (polar p_mid (angle p_mid p2) (* len 0.5)) lst_brk (list brk2 brk1) ) (mapcar '(lambda (x) (add_vtx obj (vlax-curve-getparamatpoint ename x) ename)) lst_brk) (setq dxf_obj (entget ename)) (if (cdr (assoc 43 dxf_obj)) (setq dxf_43 (cdr (assoc 43 dxf_obj))) (setq dxf_43 0.0) ) (if (cdr (assoc 38 dxf_obj)) (setq dxf_38 (cdr (assoc 38 dxf_obj))) (setq dxf_38 0.0) ) (if (cdr (assoc 39 dxf_obj)) (setq dxf_39 (cdr (assoc 39 dxf_obj))) (setq dxf_39 0.0) ) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj)) dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj)) dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj)) dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj)) dxf_210 (cdr (assoc 210 dxf_obj)) ) (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1))) (setq dxf_10 (append dxf_10 (list (car dxf_10))) dxf_40 (append dxf_40 (list (car dxf_40))) dxf_41 (append dxf_41 (list (car dxf_41))) dxf_42 (append dxf_42 (list (car dxf_42))) ) ) (repeat (1+ (length lst_brk)) (setq ltmp nil lst_tmp (vl-member-if '(lambda (x) (and (equal (car x) (caar lst_brk) 1E-08) (equal (cadr x) (cadar lst_brk) 1E-08))) dxf_10) where (if lst_tmp (vl-position (car lst_tmp) dxf_10) 0) ) (repeat (setq count (- (length dxf_10) where)) (setq ltmp (cons (mapcar '(lambda (x y) (cons y (nth where x))) (list dxf_10 dxf_40 dxf_41 dxf_42) (list 10 40 41 42)) ltmp)) (setq where (1+ where)) ) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (assoc 8 dxf_obj) (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256)) (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER")) (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1)) (cons 100 "AcDbPolyline") (cons 90 (length ltmp)) (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128)) (cons 38 dxf_38) (cons 39 dxf_39) ) (apply 'append (reverse ltmp)) (list (cons 210 dxf_210)) ) ) (setq e_last (entlast)) (if (eq (length lst_brk) 1) (progn (vla-Offset (vlax-ename->vla-object e_last) (* lap -0.05)) (entdel e_last) ) (if (zerop (length lst_brk)) (progn (setq nw_pt (polar (cdr (assoc 10 (reverse (entget e_last)))) (angle (cdr (assoc 10 (reverse (entget e_last)))) p_mid) lap)) (entmod (reverse (subst (cons 10 nw_pt) (assoc 10 (reverse (entget e_last))) (reverse (entget e_last))))) ) (progn (setq nw_pt (polar (cdr (assoc 10 (entget e_last))) (angle (cdr (assoc 10 (entget e_last))) p_mid) lap)) (entmod (subst (cons 10 nw_pt) (assoc 10 (entget e_last)) (entget e_last))) ) ) ) (repeat (1- count) (setq dxf_10 (reverse (cdr (reverse dxf_10))) dxf_40 (reverse (cdr (reverse dxf_40))) dxf_41 (reverse (cdr (reverse dxf_41))) dxf_42 (reverse (cdr (reverse dxf_42))) ) ) (setq lst_brk (cdr lst_brk) ltmp nil) ) (entdel ename) ) (T (princ "\nCut length is too large")) ) ) (vla-endundomark AcDoc) ) (T (princ "\nNo valid object delected for the fonction")) ) (prin1) )
    1 point
  21. I used Bricscad and just did Join and selected all line work. There is a fuzz setting mine may be different will try to find it. "PEDIT command>Multiple>select entities>Join>Fuzz Factor.... HELP explains the PEDIT command structure, you can review it for tips and ideas."
    1 point
  22. Try This - alter the file and keywords to suit in the TEST command. Tested and seems to work OK for me. It re-writes the original file, so let me know if you would rather save to a new file or back up original. NOTE: it will only work if the keywords are on their own line, and the keywords are also case sensitive. (defun StripTextAtKwords (file kw1 kw2 / flg fp ln ls n) (if (and file (setq file (findfile file))) (progn (setq fp (open file "r") flg nil) (while (setq ln (read-line fp)) (if (= ln kw1)(setq flg T ls (cons ln ls))) (if (= ln kw2)(setq flg nil)) (if (not flg)(setq ls (cons ln ls))) ) (close fp) (if ls (progn (setq fp (open file "w") ls (reverse ls) n 0 ) (repeat (length ls) (write-line (nth n ls) fp) (setq n (1+ n)) ) (close fp) (princ "\nFile Updated.") ) ) ) (princ "\nFile Not found.") ) (princ) ) (defun c:test () (StripTextAtKwords "keywords.txt" "keyword1" "keyword2") )
    1 point
  23. How about something like this? ;; Performs a function on all items in a selection set. (defun mapss (ss func) (mapcar func (mapcar 'cadr (ssnamex ss))) ) ;; Test command. Returns a list of layers from the selection set. (defun c:test () (mapss (ssget "X") '(lambda (x)(cdr (assoc 8 (entget x))))) )
    1 point
  24. Try this one as well, taking out the 'entlast' parts. I've added comments what I changed on your original (defun c:ac1 ( / ss1 entname1 obj1 ent1area ss2 ent2name obj2 ent2area ent3name obj3 ent3area) ;; (setq ss1 nil) ;;Union can work on entities, not necessary to make selection set ;; (setq ss1 (ssadd)) ;;As above (setq ent1name (car (entsel "\nSelect region 1: "))) (setq obj1 (vlax-ename->vla-object ent1name)) (setq ent1area (rtos (vla-get-area obj1) 2 3)) ;; (ssadd ent1name ss1) ;;As above (setq ent2name (car (entsel "\nSelect region 2: "))) (setq obj2 (vlax-ename->vla-object ent2name)) (setq ent2area (rtos (vla-get-area obj2) 2 3)) ;; (ssadd ent2name ss1) ;;As above ;; (command "union" ss2 "") ;;Union works on Entities ;; (setq ent3name (entlast)) ;;Union modifies ent1 so use that ;; (setq obj3 (vlax-ename->vla-object ent3name)) ;; (setq ent3area (rtos (vla-get-area obj3) 2 3)) (command "union" ent1name ent2name "") ; modified 'union' line (setq ent3area (rtos (vla-get-area obj1) 2 3)) ; Use 'Ent1', and 'Obj1' );end defun
    1 point
  25. A couple more suggestions, I have been making scripts for like 40 years, the main task is to get a file of dwg names, there are a few way I use old fashioned DOS, I put the file in a text editor and use replace to make the script. You can use VL-DIRECTORY-FILES to get a list of files. Also you can run lisp from a script generally best to use load and followed by defun name and values. Some can not be used. "Is it possible to execute commands that interact with control windows in manual mode? for example to specify an OK" When tunning a script you would have any user input.
    1 point
  26. Scripts. On a very basic level, if the command can run in CAD then you can automate running that and I think there are 3 basic methods: Run on file open. Which might be a LISP routine, when the file opens it runs the specified routine and this runs every time any file is opened. For example I have a couple that do this, one sets up the object snaps as I like them, another makes a little record into a text file of the file name as it opens. Another type is to loop through a list of drawings (typically all contained in a single folder), open each, run a series of commands, save and close as required. Like the one above this can use any command that you can run in CAD. Might be something like drawing a line, might be running a LISP. The opening and closing is controlled by the script. A third type is from the core console which does it all in the background, no files opened, but this doesn't have all the commands available, VLA- commands for example, however it is very quick. It won't do anything that needs the graphic interface though. Lee Macs ScriptWriter and ScriptPro tend to do things in the background - I forget how, but have a nice interface for you to create the script. I prefer the middle option, open file, do stuff, close file via a script partially that that creartes a .bak file if I make a mistake and need to go back a step. I also look at a script as a method to do stuff and go and make coffee which means no user interaction. A lot of commands that have a command window / pop up requiring say "OK" also have a command line version only and it is better to use these, adding the "OK" as a part of the command call. Very tricky to hit a button with a script. Switching between files is possible but you need to specify which files to go from and to. Better to have these copied before the script starts and just paste. Might be that you run a few iterations pasting an object from a clipboard each time. However for xrefs you can do that via the command line, no need to open another drawing, same with block files. Yes for changing layer and block names and attributes. All depends what you want to do but it all looks possible from your question
    1 point
×
×
  • Create New...