Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/14/2021 in all areas

  1. Another with While function. (defun Up:to:within ( itm lst / out ) (if (vl-position itm lst) (progn (while (and (/= (setq rtn (car lst)) itm) (setq out (cons rtn out)) (setq lst (cdr lst)))) (setq out (reverse (cons itm out))) ) ) ) Usage: (Up:to:within "dd" '("aa" "bb" "cc" "dd" "ee"))
    2 points
  2. This is what i did for picking how many tabs of a template i wanted to insert. (setq lst '(Cover D01 D02 D03 D04 D05 D06 D07 D08 D09 D10)) (if (not (setq i (getreal "Number of Drawers [1-10]<10>:"))) (setq i 10) ) (setq i (1+ i)) (while (< i (vl-list-length lst)) (setq lst (vl-remove (nth i lst) lst)) )
    1 point
  3. Grab Process Monitor and watch file/registry activity during this 8-12 second wait. I bet there is some path, file, etc. that AutoCAD is asking the O/S for, and it can't find it, hence the delay. Another quick test is to unplug the network cable, disconnect all WiFi connections, etc., and test again. If there are no network connections, Windows will not have a delay when looking for whatever. It gives up immediately.
    1 point
  4. Problem is the number of pauses you need is dependant on the current qleader settings. Frank Whaley at Autodesk created qlset.lsp that can set any qleader settings to fit whatever you want to do with your qleader lisp and reset those settings afterwards if you wish. I've attached qlset.lsp and lead.lsp I wrote years ago as an example you can modify to suit your needs. I'd suggest reading Frank Whaley's code first to see all it can do. If you search for qlset.lsp you'll find many other examples. lead.lsp qlset.lsp
    1 point
  5. However, if I was to be asked how should table look like, I'd suggest something like this (double vertices in table represent segments of polyline)... BTW. It works and for S areas... (defun c:areatbl ( / LM:PolyCentroid vertn lst2table mid s lw pl c ml pll header lww cc arean v1 v2 plln plll k data pt ) (vl-load-com) ;; Polygon Centroid - Lee Mac ;; Returns the WCS Centroid of an LWPolyline Polygon Entity (defun LM:PolyCentroid ( e / l ) (foreach x (setq e (entget e)) (if (= 10 (car x)) (setq l (cons (cdr x) l))) ) ( (lambda ( a ) (if (not (equal 0.0 a 1e-8)) (trans (mapcar '/ (apply 'mapcar (cons '+ (mapcar (function (lambda ( a b ) ( (lambda ( m ) (mapcar (function (lambda ( c d ) (* (+ c d) m)) ) a b ) ) (- (* (car a) (cadr b)) (* (car b) (cadr a))) ) ) ) l (cons (last l) l) ) ) ) (list a a) ) (cdr (assoc 210 e)) 0 ) ) ) (* 3.0 (apply '+ (mapcar (function (lambda ( a b ) (- (* (car a) (cadr b)) (* (car b) (cadr a))) ) ) l (cons (last l) l) ) ) ) ) ) (defun vertn ( blk / atts name ) (if (eq (type blk) 'ename) (setq blk (vlax-ename->vla-object blk)) ) (setq atts (vlax-invoke blk 'getattributes)) (foreach att atts (if (= (vla-get-tagstring att) "PONTO") (setq name (vla-get-textstring att)) ) ) name ) (defun lst2table ( lst pt / as cols rh cw ttl data rows sty tbl r k ) (vl-load-com) (setq rh (vla-gettextheight (setq sty (vla-item (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "acad_tablestyle") (getvar 'ctablestyle) ) ) acdatarow ) ) (setq pt (vlax-3d-point (trans pt 1 0)) as (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) cols (if (listp (caadr lst)) (length (caadr lst)) (length (car lst))) ttl (if (not (listp (car lst))) (car lst)) data (if (not (listp (car lst))) (cadr lst) lst) data (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) (if (null y) "" y)) x)) data) rows (if (not (listp (car lst))) (1+ (length data)) (length data)) ) (if ttl (vla-enablemergeall sty "Title" :vlax-true) (vla-enablemergeall sty "Title" :vlax-false) ) (setq cw (apply 'max (mapcar '(lambda ( x ) (apply 'max (mapcar 'strlen x))) (apply 'mapcar (cons 'list data))))) (setq tbl (vla-addtable as pt rows cols (* 2.5 rh) (* 0.8 cw))) (if (vlax-property-available-p tbl 'regeneratetablesuppressed t) (vla-put-regeneratetablesuppressed tbl :vlax-true) ) (vla-put-stylename tbl (getvar 'ctablestyle)) (if ttl (progn (vla-settext tbl 0 0 ttl) (setq r 1) ) (setq r 0) ) (foreach i data (setq k -1) (foreach ii i (vla-settext tbl r (setq k (1+ k)) ii) (cond ( (and ttl (> r 1)) (vla-setcellalignment tbl r k acmiddlecenter) ) ( (and (not ttl) (= r 0)) nil ) ( t (vla-setcellalignment tbl r k acmiddlecenter) ) ) ) (setq r (1+ r)) ) (setq cw (mapcar '(lambda ( x ) (apply 'max (mapcar 'strlen x))) (apply 'mapcar (cons 'list data)))) (setq k -1) (foreach c cw (vla-setcolumnwidth tbl (setq k (1+ k)) (* c rh 1.25)) ) (if (vlax-property-available-p tbl 'regeneratetablesuppressed t) (vla-put-regeneratetablesuppressed tbl :vlax-false) ) (vla-update tbl) (princ) ) (defun mid ( p1 p2 ) (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2) ) (vl-cmdf "_.zoom" "_e") (prompt "\nPick closed LWPOLYLINE without arced segments...") (if (setq s (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1) (-4 . "<not") (-4 . "<>") (42 . 0.0) (-4 . "not>")))) (progn (setq lw (ssname s 0)) (setq pl (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (entget lw)))) (setq c (LM:PolyCentroid lw)) (setq ml (mapcar '(lambda ( a b ) (mid a b)) pl (append (cdr pl) (list (car pl))))) (setq pll (mapcar '(lambda ( a b c ) (list a b c)) pl ml (append (cdr pl) (list (car pl))))) (setq header (cdr (assoc 1 (entget (ssname (ssget "_C" (mapcar '+ (trans c 0 1) '(-10.0 -10.0)) (mapcar '+ (trans c 0 1) '(10.0 10.0)) '((0 . "TEXT"))) 0))))) (foreach x pll (setq lww (ssname (ssdel lw (ssget "_C" (mapcar '+ (trans (cadr x) lw 1) '(-0.01 -0.01)) (mapcar '+ (trans (cadr x) lw 1) '(0.01 0.01)) '((0 . "LWPOLYLINE")))) 0)) (if lww (progn (setq cc (LM:PolyCentroid lww)) (setq arean (cdr (assoc 1 (entget (ssname (ssget "_C" (mapcar '+ (trans cc 0 1) '(-10.0 -10.0)) (mapcar '+ (trans cc 0 1) '(10.0 10.0)) '((0 . "TEXT"))) 0))))) (setq v1 (vertn (ssname (ssget "_C" (mapcar '+ (trans (car x) lw 1) '(-0.01 -0.01)) (mapcar '+ (trans (car x) lw 1) '(0.01 0.01)) '((0 . "INSERT") (66 . 1))) 0))) (setq v2 (vertn (ssname (ssget "_C" (mapcar '+ (trans (caddr x) lw 1) '(-0.01 -0.01)) (mapcar '+ (trans (caddr x) lw 1) '(0.01 0.01)) '((0 . "INSERT") (66 . 1))) 0))) (setq plln (cons (list v1 arean v2) plln)) (setq plll (cons x plll)) ) ) ) (setq plln (reverse plln)) (setq k -1) (setq data (apply 'append (mapcar '(lambda ( x ) (setq k (1+ k)) (list (list (car x) (rtos (caar (nth k plll)) 2 3) (rtos (cadar (nth k plll)) 2 3) (rtos (distance (car (nth k plll)) (caddr (nth k plll))) 2 3) (cadr x)) (list (caddr x) (rtos (caaddr (nth k plll)) 2 3) (rtos (cadr (caddr (nth k plll))) 2 3) (rtos (distance (car (nth k plll)) (caddr (nth k plll))) 2 3) (cadr x)))) plln))) (setq data (cons (list "Da" "Coord. E" "Coord. N" "Dist\U+00E2ncia" "SIDES") data)) (setq data (list header data)) (initget 1) (setq pt (getpoint "\nSpecify insertion Upper Left point for table...")) (lst2table data pt) ) (prompt "\nMissed... Try next time...") ) (vl-cmdf "_.zoom" "_p") (princ) ) Regards, M.R.
    1 point
  6. Another couple - (defun foo2 ( x l ) (cond ((not l) l) ((= x (car l)) (list x)) ((cons (car l) (foo2 x (cdr l))))) ) (defun foo3 ( x l / f ) (setq f (lambda ( y ) (if (= x y) (not (setq f (lambda ( y ) t)))))) (vl-remove-if '(lambda ( z ) (f z)) l) )
    1 point
  7. (defun foo ( el lst ) (member el (reverse lst)) ) (foo "cc" '("aa" "bb" "cc" "dd")) => ("cc" "bb" "aa") HTH. M.R.
    1 point
×
×
  • Create New...