Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/30/2020 in all areas

  1. Quite a few answers on the web already:
    2 points
  2. I didn't know you could do that with a right click ronjon, never looked for that either though
    1 point
  3. That's not being dense, you just haven't learned it yet. I was once told... "Never assume a lack of knowledge as a weakness." We ALL have to learn.
    1 point
  4. After shamelessly stealing @Tharwat's code here is my take on said code (defun rh:getlwp ( msg / flg ss ent) (while (not flg) (prompt (strcat "\nSelect " msg " Polyline : ")) (setq ss (ssget "_+.:E:S:L" '((0 . "LWPOLYLINE")))) (cond (ss (setq ent (ssname ss 0) flg T)) (t (alert "Nothing Selected")) );end_cond );end_while ent );end_defun (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) ) (vl-load-com) (defun c:Test (/ *error* a_app c_doc c_spc sv_lst sv_vals ss uent lent ulst llst ss c1 c2 x1 x2 x3 x4) (defun *error* ( msg ) (mapcar 'setvar sv_lst sv_vals) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred"))) (princ) );end_defun (setq a_app (vlax-get-acad-object) c_doc (vla-get-activedocument a_app) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) sv_lst (list 'cmdecho 'osmode) sv_vals (mapcar 'getvar sv_lst) ss (ssadd) );end_setq (mapcar 'setvar sv_lst '(0 0)) (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER)))))) (alert "Current layer is locked!. Unlock then try again."))) (setq uent (rh:getlwp "Upper") c1 (vlax-curve-getpointatdist uent (/ (vlax-curve-getdistatparam uent (vlax-curve-getendparam uent)) 2.0)) lent (rh:getlwp "Lower") c2 (vlax-curve-getpointatdist lent (/ (vlax-curve-getdistatparam lent (vlax-curve-getendparam lent)) 2.0)) );end_setq (foreach x (list uent lent) (ssadd x ss)) (setq lst (LM:ssboundingbox ss)) (vlax-invoke a_app 'zoomwindow (car lst) (cadr lst)) (setq x1 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getstartpoint uent)) (polar pt (* pi 0.5) 1.0)) x2 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getendpoint uent)) (polar pt (* pi 0.5) 1.0)) x3 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getstartpoint lent)) (polar pt (* pi 0.5) 1.0)) x4 (vlax-invoke c_spc 'Addxline (setq pt (vlax-curve-getendpoint lent)) (polar pt (* pi 0.5) 1.0)) pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) c1 c2) );end_setq (vl-cmdf "_-boundary" pt "") (mapcar 'vla-delete (list x1 x2 x3 x4)) (vlax-invoke a_app 'zoomprevious) (mapcar 'setvar sv_lst sv_vals) (princ) );end_defun Just select the upper and lower lwpolylines. I have asked for upper and lower in that order, but I don't think the order matters.
    1 point
  5. I often plot to fit for many reasons. Every plot on the planet is not necessarily a title blocked drawing. Even then, some ask me to plot to 11x17 or most can only plot to 11x17, usually I set drawings up at Arch D, if I set Plot to Fit, they only need find the correct printer, some things I also set for default printer and I usually never hear from them to come help. If everything is set to correct titleblock and border size, it will still plot 1:1 on plot to fit and correct paper size or I can quickly change it anyway. If somebody wants a certain section of a drawing, then a different scale or plot to fit and Window is needed. I could go on and on for reasons to plot at other than 1:1. Even now I am making fire exit floor plans, no need for a scale, need to get as much on a sheet as I can for visibility.
    1 point
  6. Alright, this should cover more cases. (defun c:Test (/ p1 p2 p3 ss c1 c2 x1 x2 sp cd) ;; Tharwat - 29.Sep.2020 ;; (and (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))) ) ) ) (alert "Current layer is locked!. Unlock then try again.") ) (setq p1 (getpoint "\nSpecify end point of first polyline : ")) (or (setq ss (ssget p1 '((0 . "LWPOLYLINE")))) (alert "No LWpolyline found at that point. Try again.") ) (setq c1 (mid_ ss)) (setq p2 (getcorner "\nSpecify end point of second polyline : " p1)) (or (setq ss (ssget p2 '((0 . "LWPOLYLINE")))) (alert "No LWpolyline found at that point. Try again.") ) (setq c2 (mid_ ss)) (setq cd (vlax-get-acad-object) sp (vla-get-block (vla-get-activelayout (vla-get-ActiveDocument cd)) ) ) (setq x1 (vlax-invoke sp 'Addxline p1 (polar p1 (* pi 0.5) 1.0))) (setq x2 (vlax-invoke sp 'Addxline p2 (polar p2 (* pi 0.5) 1.0))) (progn (vla-ZoomExtents cd) (command "_.-boundary" "_none" (mapcar '(lambda (j k) (/ (+ j k) 2.0)) c1 c2) "" ) (mapcar 'vla-delete (list x1 x2)) (vla-Zoomprevious cd) ) ) (princ) ) (vl-load-com) (defun mid_ (ss / ent len mid) (setq ent (ssname ss 0) len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) mid (vlax-curve-getpointatdist ent (/ len 2.0)) ) mid )
    1 point
  7. The shortest way could be this way I believe. (defun c:Test (/ p1 p2 p3 ss c1 c2 sr nw cd) ;; Tharwat - 29.Sep.2020 ;; (and (or (/= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))) ) ) ) (alert "Current layer is locked!. Unlock then try again.") ) (setq p1 (getpoint "\nSpecify end point of first polyline : ")) (or (setq ss (ssget p1 '((0 . "LWPOLYLINE")))) (alert "No LWpolyline found at that point. Try again.") ) (setq c1 (mid_ ss)) (setq p2 (getcorner "\nSpecify end point of second polyline : " p1)) (or (setq ss (ssget p2 '((0 . "LWPOLYLINE")))) (alert "No LWpolyline found at that point. Try again.") ) (setq c2 (mid_ ss)) (setq st (entlast) cd (vlax-get-acad-object) ) (progn (vl-cmdf "_.RECTANG" "_none" p1 "_none" p2) (if (/= st (setq nw (entlast))) (progn (vla-ZoomExtents cd) (command "_.-boundary" "_none" (mapcar '(lambda (j k) (/ (+ j k) 2.0)) c1 c2) "" ) (entdel nw) (vla-Zoomprevious cd) ) ) ) ) (princ) ) (vl-load-com) (defun mid_ (ss / ent len mid) (setq ent (ssname ss 0) len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) mid (vlax-curve-getpointatdist ent (/ len 2.0)) ) mid )
    1 point
  8. Found some time try this ; count circles in pline ; by Alanh Sep 2020 (defun c:circpl ( / num x lst tot numrows) (defun ahmaketable (/ colwidth numcolumns rowheight sp vgms) (vl-load-com) (setq sp (vlax-3d-point (getpoint "pick a point for table"))) (Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ; (setq numrows 2) (setq numcolumns 3) (setq rowheight 2.5) (setq colwidth 60) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Circle count"); TABLE TITLE (vla-settext objtable 1 0 "NO."); TABLE TITLE (vla-settext objtable 1 1 "Diameter") (vla-settext objtable 1 2 "Count") (command "_zoom" "e") (princ) ) (defun ah:addrow ( / ) (vla-InsertRows objtable (+ numrows 1) (vla-GetRowHeight objtable (- numrows 1)) 1) (vla-settext objtable numrows 0 (rtos num 2 0)) (vla-settext objtable numrows 1 (rtos n1 2 2)) ;1st column is zero (vla-settext objtable numrows 2 (rtos tot 2 0)) (setq numrows (+ numrows 1)) (setq num (+ num 1)) (setq tot 0) ) (while (setq ent (entsel "\npick boundry pline")) (if (= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE") (progn (ahmaketable) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent))))) (setq ss (ssget "_WP" co-ord '(( 0 . "CIRCLE")))) (setq lst '()) (repeat (setq x (sslength ss)) (setq lst (append lst (list (cdr (assoc 40 (entget (ssname ss (setq x (- x 1))))))))) ) (setq lst (mapcar 'cdr (vl-sort (mapcar '(lambda (k) (cons 1 k)) lst) '(lambda (y z) (< (cdr y) (cdr z)))))) (setq num 1 tot 0 x 0) (repeat (- (length lst)1) (setq n1 (nth x lst) n2 (nth (setq x (+ x 1)) lst)) (if (= n1 n2) (setq tot (+ tot 1)) (progn (setq tot (+ tot 1)) (ah:addrow) ) ) ) (setq tot (+ tot 1)) (setq n1 n2) (ah:addrow) ) ) ) (princ) ) (c:circpl)
    1 point
  9. The 1st part has been answered by Tharwat get a selection set of circles. Loop through the selection set and make a new list of radius's. Vl-sort the new list Loop through the new list counting the same radius value put value in a Table. Here is sample code for making a table. Make table.lsp
    1 point
×
×
  • Create New...