Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/07/2023 in all areas

  1. (apply 'append (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) (list x y)) list2)) list1))
    2 points
  2. @Elektrik Also don't forget to localize all those variables. (defun c:oa (/ area endpointl endpointw rlenght rlength rwidth startpointl startpointw);<- LOCALIZED VARIABLES ( SETQ .. (setq startpointl (getpoint "\nEnter the starting point of the room length: ")) (setq endpointl (getpoint "\nEnter the end point of the room length: ")) (setq rlength (distance startpointl endpointl)) (setq startpointw (getpoint "\nnter the starting point of the room width: ")) (setq endpointw (getpoint "\nEnter the end point of the room width: ")) (setq rwidth (distance startpointw endpointw)) (setq area (* rlength rwidth)) (alert (strcat "\nRoom Area= " (rtos area))) (princ) )
    1 point
  3. So you could use ssget (see http://lee-mac.com/ssget.html ) to select block 1: This will select all blocks. (setq ss (ssget "_X" ' ((0. "INSERT") (2. "Block Name"))) ) Then loop through the selection set with a while, repeat foreach or however loop Using the selected block you can get it's insert point: (setq MyBlock (ssname ss count)) ; where count is the item number in the selection set (set pt (cdr (assoc 10 (entget Myblock)))) ; gets the insertion point of the block And then back to selection set, select all block 2 that lie within an area of this insertion point: (setq pt1 (mapcar '+ (-5 -5 0) pt)) ; 4 corners of a rectabgle round the block (setq pt2 (mapcar '+ (-5 +5 0) pt)) (setq pt3 (mapcar '+ (+5 +5 0) pt)) (setq pt4 (mapcar '+ (+5 -5 0) pt)) (setq ss2 (ssget "_CP" (list pt1 pt2 pt3 pt4) '((2 . "Block Name 2")) )) and work out if ss2 is nil or a list - if it is a list then count it. Might work (CAD is off for today so the above is untested but might point you near to what you want) As Dan above, post your LISP if you can and it might be a simple change in that to make it work - keeping the work you did
    1 point
  4. (vl-load-com) (defun c:TextElevation (/ c_doc c_lyrs ss clyr cnt t_obj elev lyr_txt prms npoints) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vla-get-layers c_doc) clyr (getvar 'clayer) ) ;end_setq (prompt "\nSelect Texts : ") (setq ss (ssget '((0 . "TEXT")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq t_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (setq elev (caddr (vlax-safearray->list (vlax-variant-value (vlax-get-property t_obj 'InsertionPoint)) ) ) ) (cond ((< elev 650.0) (setq lyr_txt "NO_ELEV")) ((= (rem (fix elev) 0.1) 0.1) (setq lyr_txt (strcat (itoa (0.1+ (fix elev))))) ) (t (setq lyr_txt (strcat (itoa (fix elev))))) ) ;end_cond (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt)) (vlax-put-property t_obj 'layer lyr_txt) ) ;end_repeat ) ) ;end_cond (setvar 'clayer clyr) (princ) );end_defun you want this?
    1 point
  5. Try this. I'm not sure I caught all possible errors, please test it in different scenarios. Ah yes, I took the lazy route of making sure the range value is always a 2-dimensional array. When the range is a single cell, the Value property returns its contents. (defun c:DCOL ( / variantvalue msg excel sheet range rows lst) (defun VariantValue (x / var) (cond ((not x) nil) ((eq (type x) 'safearray) (VariantValue (vlax-safearray->list x)) ) ((eq (type x) 'variant) (if (vl-catch-all-error-p (setq var (vl-catch-all-apply 'vlax-variant-value (list x))) ) nil (VariantValue var) ) ) ((listp x) (mapcar 'VariantValue x)) (T x) ) ) (if (and (setq msg "\nExcel is not open.") (setq excel (vlax-get-object "Excel.Application")) (setq msg "\nNo active sheet found.") (setq sheet (vlax-get excel "ActiveSheet")) (setq range (vlax-get sheet "UsedRange")) (setq rows (vlax-get (vlax-get range "Rows") "Count")) (setq range (vlax-get-property sheet "Range" (strcat "D1:D" (itoa rows)))) (setq msg "\nD column is empty.") (setq lst (variantValue (vlax-get-property range "value"))) ) (progn (if (listp lst) (setq lst (reverse lst)) (setq lst (list (list lst))) ) (while (and lst (not (caar lst))) (setq lst (cdr lst)) ) (if lst (progn (princ "\nD") (princ (length lst)) (princ " - ") (princ (caar lst)) ) (princ "\nD column is empty.") ) ) (if msg (princ msg)) ) (princ) )
    1 point
  6. See this https://www.cadtutor.net/forum/topic/68220-how-to-know-the-latest-cell-number-in-excel-lisp/
    1 point
  7. Thanks SLW - sure determination to make it work though from me I'll have a look at the hatchedit to see why it might not work in other CADS slight change to the above, see if it works
    1 point
  8. Try this one, might work - it does in AutoCAD (defun c:Hatch2Poly ( / acount ss APoly MyPoly VertexList SplitHere MyWidth1 MyWidth2 MyWidth pt MyLayer thisdrawing vars MyCol MyLay) ;;https://www.cadtutor.net/forum/topic/24364-vertices-of-a-polyline/ (defun mAssoc ( key lst / l x ) ;Get association list entries for 'key' value (foreach x lst (if (= key (car x)) (setq l (cons (cdr x) l)) ) ; end if ) ; end foreach (reverse l) ) ; end defun (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) ; get file information (vla-EndUndoMark thisdrawing) ; clear undo marker (vla-startundomark thisdrawing) ; Start Undo marker (setq acount 0) ; a counter (princ "\n Select Hatches : ") ; Select Hatches message (setq ss (ssget '((0 . "HATCH")))) ; Select hatches ;;3 lines to disable command prompts and echo (setq vars '("CMDECHO")) (setq old (mapcar 'getvar vars)) ;;get old variables (mapcar 'setvar vars '(0)) ;;set variables to new (while (< acount (sslength ss)) ; Loop therough selection set (setq Apoly nil MyPoly nil VertexList nil SplitHere nil MyWidth1 nil MyWidth2 nil MyWidth nil pt nil MyCol nil MyLay nil ) ; reset variables - something funny happened (command "-hatchedit" (ssname ss acount) "B" "P" "Y") ; recreate hatch boundary (setq MyLay (assoc 8 (entget (ssname ss acount)) )) ; get hatch layer (setq MyCol (assoc 62 (entget (ssname ss acount)) )) ; get hatch colour (setq APoly (entlast)) ; entity name for the boundary (setq MyPoly (entget APoly)) ; entity assoc. list for boundary (setq MyPoly (subst (cons 70 0) (assoc 70 MyPoly) MyPoly )) ;; Make as open polyline (setq MyPoly (subst MyLay (assoc 8 MyPoly) MyPoly )) ;; Change Layer (entmod MyPoly)(entupd APoly) (setq MyPoly (entget APoly)) (if (= (cdr MyCol) nil) () ;; If hatch colour 'by-xyz' or not set (vla-put-Color (vlax-ename->vla-object APoly) (cdr MyCol) ) ;; Change Colour ) (setq VertexList (massoc 10 MyPoly)) ; get list of verticies for boundary (setq SplitHere (nth (/ (length VertexList) 2) VertexList)) ; split boundary coordinates ;;NOTE IF HATCH HAS UNEVEN NUMBER OF VERTICIES THIS COULD GO WEIRD (command "._break" APoly SplitHere SplitHere) ; Break the boundary at split (setq Len1 (length (mAssoc 10 (entget (entlast) )) ) ) ; verticies of last ent (setq Len2 (length (mAssoc 10 (entget APoly)) ) ) ; verticies of last ent (if (< Len1 Len2) (entdel (entlast)) (progn (entdel APoly) (setq Apoly (entlast)) ) ) (setq MyPOly (entget Apoly)) (setq VertexList (massoc 10 (entget APoly) )) ; get retained vertex list (setq MyWidth1 (distance (nth 1 VertexList) (nth 0 VertexList) )) ; get last segment widths (setq MyWidth2 (distance (nth 1 (reverse VertexList)) (nth 0 (reverse VertexList)) )) (if (< MyWidth1 MyWidth2) ; work out where to split off remaining hatch end (setq SplitHere (nth 1 VertexList) MyWidth MyWidth1 ; and the hatch width pt (nth 0 vertexlist) ) ; end setq (setq SplitHere (nth 1 (reverse VertexList)) MyWidth MyWidth2 pt (nth 0 (reverse vertexlist)) ) ; end setq ) ; end if (command "._break" APoly SplitHere SplitHere) ; split off and delte the end marker (if (< MyWidth1 MyWidth2) (progn (entdel APoly) (setq APoly (entlast)) ) ; end progn (entdel (entlast)) ) ; end if (entdel (ssname ss acount)) ; delete the hatch (command "offset" (/ MyWidth 2) APoly pt "") (entdel APoly) (command "._pedit" (entlast) "W" MyWidth "") (setq acount (+ acount 1)) ; increase counter ) ; end while ; end of while loop (mapcar 'setvar vars old) (vla-EndUndoMark thisdrawing) ; end undo marker (princ) );End
    1 point
  9. Praise be to God I found the solution (setq SelRng (vlax-get-property Sht 'Range "A1000"));CELL A1000 (vlax-invoke-method SelRng "Select") (setq NextRng (vlax-get-property ExcelApp "Selection"));SELECT_RANGE (setq DesRng (vl-catch-all-apply'vlax-get-property (list NextRng "End" -4162))); -4121 = xlUp ;GO TO UP CELLS (SETQ lastCellE (vlax-invoke-method DesRng "Select")); SELECT COUNT ROWS IN RANG LAST CELL TO A1 (setq RangROW (vlax-get-property Sht "Range" DesRng (strcat "A" (itoa 1))));get RANG LAST CELL+A1 (vlax-invoke-method RangROW "Select") (setq RowNum0 (vlax-get-property(vlax-get-property RangROW "Rows") "Count"));COUNT ROWS IN RANG LAST CELL TO A1
    1 point
×
×
  • Create New...