Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/24/2019 in all areas

  1. 2 points
  2. 1 point
  3. You should update your profile to show you are using LT.
    1 point
  4. It's not that easy. Part of the solution can be found here (I think) But it's not the exact solution to your problem
    1 point
  5. If you wish to return the first match found: (defun getmatch ( p l ) (vl-some '(lambda ( x ) (if (vl-some '(lambda ( y ) (wcmatch y p)) x) x)) l) ) _$ (getmatch "*Test*" '(("" "" "") ("" "TestA" "") ("" "" "TestB") ("TestC" "" ""))) ("" "TestA" "") If you wish to return all matches found: (defun getmatches ( p l ) (vl-remove-if-not '(lambda ( x ) (vl-some '(lambda ( y ) (wcmatch y p)) x)) l) ) _$ (getmatches "*Test*" '(("" "" "") ("" "TestA" "") ("" "" "TestB") ("TestC" "" ""))) (("" "TestA" "") ("" "" "TestB") ("TestC" "" "")) Aside @Tharwat: a relatively minor point, but if the list value returned by mapcar is not being used, in my opinion a foreach loop may be more applicable.
    1 point
  6. (apply 'append '(("HDHDHDH" "HDHDHDH" "HDHDHDH" "HDHDHDH") (1.0 "" 3.0 "S") (1.0 2.0 "" "S")))
    1 point
  7. This? (defun getMatching (pat lst / i mlst) (mapcar (function (lambda (x) (vl-some '(lambda (s) (and (wcmatch s pat) (setq mlst (cons x mlst)))) x ) ) ) lst ) (reverse mlst) )
    1 point
  8. Wow you're the hero Mr. Emmanuel. Super thanks for all your efforts and help. Now I got full set of tools to deal with messy corings and got complete control over them. BTW I also bought the book "AutoCAD Developers Guide to Visual LISP" in order make myself more familiarized with AutoLISP and also to develop my own programs. Thanks a lot.
    1 point
  9. Steven-g will confirm but if -plot is supported then you can do a macro which will plot the layout every time. Its just a case of taking the plot portion of the lisp plot code. A script would be easiest as you just do Script then say plota3. -PLOT Y "\\\\PROD\\your printer" A3 m LANDSCAPE N W -6,-6 807,560 1=2 C y Designlaser.ctb Y N N N N N y
    1 point
  10. Answering a further request, asked in another topic >> Is there any way to make it bit more regular (like starting from bottom left and continuing in some logical fashion) or there is no way around? I sorted the ss selection by X value (of the insert point of the circles). That makes it a lot more searchable. I also ask the user for a start number. So if, for example, you have a North wing of a building with 130 cores, you can start the South wing with number 131. (I removed the text "Core", set the text height to 300 and color to 200 of the labels). Notice, I could reuse function insert_sorted to sort the ss selection, here by the x-value instead of by an ID ;;;;;;;;;;;;;;;;;;; ;; draw text object (defun Text (pt hgt str color) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 62 color) (cons 1 str))) ) ;;;;;;;;;;;;;;;;;;; (vl-load-com) (defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space) ;; settings, text height, cel height (setq ht 200) (setq htc 380) ;; document, model space, ... (setq acObj (vlax-get-acad-object) acDoc (vla-get-activedocument acObj) space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace)) ) (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht) )) ;; (vla-SetTextHeight tab 1 ht) (vla-SetTextHeight tab 2 ht) (vla-SetTextHeight tab 4 ht) (vla-put-VertCellMargin tab (* 0.14 ht)) (setq i 0) (repeat (length lst) ;; iterates the rows (vla-setrowHeight tab i htc) (setq row (nth i lst)) (setq j 0) (repeat (length row) ;; iterates the cols in the row ;;(princ "\n") ;;(princ (nth j row)) (vla-SetText tab i j (nth j row) ) (setq j (+ j 1)) ) (setq i (+ i 1)) ) ;; default Autocad expects a totle row. If the first row has more than 1 cel, let's unmerge this row (if (> (length (nth 0 lst)) 1) (vla-unMergeCells tab 0 0 0 0) ) tab ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; there is a list of lists. (list (list ID IND)) . If holds a numeric ID (1 2 3 ...); ;; IND holds the index of the unsorted list ;; This function inseerts a new item, its position in the list depending on its ID. (defun insert_sorted (lst_sorted id ind / lst_new inserted id_ i) (setq inserted nil) (setq lst_new (list)) (if (= (length lst_sorted) 0) (progn ;; first item, so we insert it (setq lst_new (list (list id ind ))) ) (progn (setq i 0) ;; we loop through the existing list. When the new ID is smaller than the ID in the list => we insert the new item there (foreach item lst_sorted (setq id_ (nth 0 item)) (if (and (= inserted nil) (< id id_)) (progn (setq lst_new (append lst_new (list (list id ind )))) (setq inserted T) )) ;; continue copying the items from lst_sorted to lst_new (setq lst_new (append lst_new (list (list (nth 0 item) (nth 1 item) )))) (setq i (+ i 1)) ) ;; if the item isn't inserted yet we add it to the end (if (= inserted nil) (setq lst_new (append lst_new (list (list id ind )))) ) ) ) lst_new ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun sort_ss_by_xy (ss xOry / i j data item ip) (setq i 0) (setq data (list)) (repeat (sslength ss) (setq ip (cdr (assoc 10 (entget (ssname ss i))))) ;; insert point of the core (if (= xOry "x") ;; sort by x (setq data (insert_sorted data (nth 0 ip) i)) ;; sort by y (setq data (insert_sorted data (nth 1 ip) i)) ) (setq i (+ i 1)) ) ;;(princ data) ;; now let's rebuild a ss selection, but sorted like data (setq ss_sorted (ssadd)) (foreach item data (setq j (nth 1 item)) ;; j now holds the index of the ss selection (ssadd (ssname ss j) ss_sorted) ) ss_sorted ) ;; Offset for each Circle Center (defun c:occ ( / lst startnumber ss ss_sorted bp pt i ip radi) ;; select circles (princ "\nSelect circles then press enter: ") (setq ss (ssget (list (cons 8 "Cores") (cons 0 "CIRCLE")))) (setq ss (sort_ss_by_xy ss "x")) (setq bp (getpoint "\nBase point for offset: ")) (setq pt (getpoint "\nInsert point of the table: ")) (setq startnumber (getint "\nStart Number: ")) ;; make the list (setq lst (list (list "Core#" "x" "y" "Radius") ;; head )) (setq i 0) (repeat (sslength ss) (setq ip (cdr (assoc 10 (entget (ssname ss i))))) ;; circle center (setq radi (cdr (assoc 40 (entget (ssname ss i))))) ;; circle radius (so we know where to put the label) ;; append the list (setq lst (append lst (list (list (+ i startnumber ) ;; counter, starting with user set start number (rtos (car ip) 2 2) ;; 2 decimals, feel free to change this (rtos (cadr ip) 2 2) (rtos radi 2 2) ) ))) (Text (list (+ (nth 0 ip) (* 2. radi)) (- (nth 1 ip) radi) ) 300 (itoa (+ i startnumber)) 200 ;; purple ) (setq i (+ i 1)) ) (inserttable lst pt) )
    1 point
×
×
  • Create New...