Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/18/2023 in all areas

  1. and this one is it all put together, It doesn't make a table - should be easy enough to do that but though Command is: lstgrpblks See the last part for the next stages you might be able to do that? ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-group-names-on-drawing/td-p/807566 (defun grp:list-groups ( / doc return) (setq doc (vla-get-activeDocument (vlax-get-acad-object))) (vlax-for group (vla-get-groups doc) (setq return (cons (vla-get-name group) return)) ) ; end vlax-for (mapcar 'strcase (reverse return)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html ;;Lee Mac option ;;get all the items in a group ;;(defun selgrp (grpname / frp a1 ss ent) (defun selgrp (grpname / frp a1 ss ent enttype) ;; grpname is the group name, it accepts unnamed groupnames, such as *A1 (setq grp (dictsearch (namedobjdict) "ACAD_GROUP")) (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname)) (setq ss (ssadd)) (while (/= (assoc 340 a1) nil) (setq ent (assoc 340 a1)) (if (= (cdr (assoc 0 (entget (cdr ent)))) "INSERT") ; only blocks (progn (setq ss (ssadd (cdr ent) ss)) ) ; end progn (progn ) ; end progn ) ; end if (setq a1 (subst (cons 0 "") ent a1)) ) ; end while ss ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://www.cadtutor.net/forum/topic/55506-lisp-to-return-name-of-selected-blocks/ ;;(defun c:simplecount ( / blk idx itm lst sel ) ;; Define function, declare local variables (defun simplecount ( sel / blk idx itm lst ) ;; Define function, declare local variables (setq SimpLspResult (list)) ;; (if ;; If the following expression returns a non-nil value ;; (setq sel ;; Assign the value returned by the following expression to the symbol 'sel' ;; (ssget ;; Prompt the user to make a selection and return the selection set if successful ;; '((0 . "INSERT")) ;; Filter the selection to block references only (INSERTs) ;; ) ;; end ssget ;; ) ;; end setq (repeat ;; Repeat the enclosed expressions the following number of times: (setq idx ;; Assign the value returned by the following expression to the symbol 'idx' (sslength sel) ;; Return the number of items in the selection set ) ;; end setq (setq blk ;; Assign the block name to the variable 'blk' (cdr ;; Retrieve the value associated with DXF group 2 (the block name) (assoc 2 ;; Retrieve the DXF group 2 dotted pair from the following DXF data (entget ;; Retrieve the list of DXF data for the following entity (ssname sel ;; Retrieve the entity at the following index (setq idx (1- idx)) ;; Decrement the index variable (since selection set indexes are zero-based) ) ;; end ssname ) ;; end entget ) ;; end assoc ) ;; end cdr ) ;; end setq ;; If the block is already recorded in the list: (if ;; If the following expression returns a non-nil value (setq itm ;; Assign the value returned by the following expression to the symbol 'itm' (assoc blk lst) ;; Attempt to retrieve a list item whose first element is equal to the block name ) ;; end setq ;; Update the existing list entry: (setq lst ;; Redefine the 'lst' variable with the updated list data (subst ;; Substitute the following list item in the list (cons blk (1+ (cdr itm))) ;; Increment the number of occurrences recorded for this item in the list itm ;; The existing item to be substituted lst ;; The list in which to perform the substitution ) ;; end subst ) ;; end setq ;; Else add a new entry to the list: (setq lst ;; Redefine the 'lst' variable with the following updated list data (cons ;; 'Push' a new item onto the front of the list (cons blk 1) ;; Construct a dotted pair whose first key is the block name and value is 1 lst ;; The list to which the item should be added (may be nil) ) ;; end cons ) ;; end setq ) ;; end if ) ;; end repeat ;; Else the user didn't make a selection ;; ) ;; end if ;; Print the results (if they exist) (foreach itm lst ;; For every 'itm' in the list given by 'lst' ;; (princ ;; Print the following to the command-line (setq SimpLspResult (append SimpLspResult (list (strcat ;; Concatenate the following strings "\n" ;; (New-line character) (car itm) ;; The block name ": " ;; An arbitrary separator for the data (itoa (cdr itm)) ;; The number of occurrences of the block, converted to a string ) ;; end strcat ))) ; end setq ;; ) ;; end princ ) ;; end foreach (princ) ;; Suppress the return of the last evaluated expression (if) SimpLspResult ; return result ) ;; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:lstgrpblks ( / MyGroups acount GroupsSS blklst) (setq MyGroups ( grp:list-groups ) ) (setq acount 0) (setq GroupsSS (list)) (while (< acount (length MyGroups)) (setq blklst (simplecount (selgrp (nth acount MyGroups)) ) ) (princ "\n") (princ (nth acount MyGroups)) ;; Group Name (princ "\n") (princ blklst) ;; blklst: Block name : Ocurrance. Use LM string -> List to split up (del ':'), ;; append this list as MyGroup Block_name Occurances ;; get insert point for table ;; entmake table (setq acount (+ acount 1)) ) ; end while )
    2 points
  2. As suggested I use a custom mnu rather than using the CUI as the editor, you just make a menu using notepad. You can make custom toolbars the same way. Behind the menu is a Autoload or a load a lisp. Another
    2 points
  3. This? (vl-load-com) (defun add_vtx (obj add_pt ent_name / bulg) (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 bulg (vla-GetBulge obj (fix add_pt))) (vla-SetBulge obj (fix add_pt) (/ (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4)) ) ) (vla-update obj) ) (defun c:div-vertex_po ( / ss max_l n ent obj_vla pr dist_end dist_start seg_len div l_div l) (princ "\nSelect polylines.") (while (null (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSelect is empty, or isn't POLYLINE!") ) (initget 7) (setq max_l (getdist "\nMax length between vertex: ")) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) obj_vla (vlax-ename->vla-object ent) pr (fix (vlax-curve-getEndParam ent)) ) (repeat (fix (vlax-curve-getEndParam ent)) (setq dist_end (vlax-curve-GetDistAtParam ent pr) dist_start (vlax-curve-GetDistAtParam ent (setq pr (1- pr))) seg_len (- dist_end dist_start) div (1+ (fix (/ seg_len max_l))) l_div (/ seg_len div) l l_div ) (while (< l seg_len) (add_vtx obj_vla (vlax-curve-getparamatdist ent (- dist_end l)) ent) (setq l (+ l l_div)) ) ) ) (prin1) )
    1 point
  4. Hi Sofiane, I didn't get chance to think about this last night. Working with groups doesn't get asked so often here, which is why answers might be a bit slow. How are you with LISP? What I am about to write might make perfect sense, might confuse you, but just putting some thoughts here to come back to later or as an idea for you If you can select a group with LISP, below will make a selection set of the objects in that group (https://adndevblog.typepad.com/autocad/2012/12/how-to-add-a-group-in-a-selection-set-from-an-autolisp-function.html). If you have a selection set I think you can change or use Lee Macs code above and that SS to create the table. Otherwise need to loop through the selection set and count through the blocks it contains. Got to look for something to return the group name a selected object belongs to. So this is from the link above (defun selgrp (grpname) ;; grpname is the group name, it accepts ;; unnamed groupnames, such as *A1 (setq grp (dictsearch (namedobjdict) "ACAD_GROUP")) (setq a1 (dictsearch (cdr (assoc -1 grp)) grpname)) (setq ss (ssadd)) (while (/= (assoc 340 a1) nil) (setq ent (assoc 340 a1)) (setq ss (ssadd (cdr ent) ss)) (setq a1 (subst (cons 0 "") ent a1)) ) ss ) This looks like you select something and it returns the group name: (https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-group-name-of-an-entity/m-p/1526241/highlight/true#M201038) Tested this one: (defun c:ggn ( / grpnm ) (setq grpnm (GGN (car (entsel)))) ) (defun GGN (obj / groups res) (setq groups (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))) (if (= (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj)) ) (vlax-for x groups (vlax-for item x (if (equal obj item) (setq res (cons (vlax-get x 'Name) res)) ) ) ) (reverse res) ) So I reckon this will make a selection set of all the objects within a group of you click on an object in the group: (setq ss (selgrp (cadr (GGN (car (entsel))))) ) Right that is google running white hot with all this searching. Next is to make a list of all the block types in the selection set returned above and make up a nice table
    1 point
  5. I find things learn yourself are hard to forget. tho here are some pointers. (defun c:adim (/ mspace ss blk pts p1 p2 p3 dim) (vl-load-com) (vla-startundomark (setq Drawing (vla-get-activedocument (vlax-get-acad-object)))) ;undo start point (setq mspace (vla-get-ModelSpace Drawing)) (if (setq ss (ssget '((0 . "INSERT")))) ;limit selection to blocks (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pts (cons (cdr (assoc 10 (entget blk))) pts)) ) ) (setq pts ;sorts points (vl-sort pts '(lambda (a b) (if (equal (car a) (car b) 1e-6) (< (cadr a) (cadr b)) (< (car a) (car b)) ) ) ) ) (while (> (length pts) 1) ;loop if thier is more then one point left (setq p1 (car pts)) (setq p2 (cadr pts)) (setq MPT (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) midpoint between p1 & p2 (setq p3 (polar MPT (+ (angle p1 p2) (/ pi 2)) 10)) (setq dim (vla-AddDimAligned mspace p1 p2 p3)) (setq pts (cdr pts)) ;Returns a list containing all but the first element of the list ) (vla-EndUndoMark Drawing) (princ) )
    1 point
  6. hii, i got finally that lisp that i wanted after i learned myself.i am very disappointed at the beginning. this lisp might useful for someone to make automatic dimensions for block alhamdulillah thanks to god. (defun c:adim(/ acadObj doc modelSpace ss ip n p1 p2 p3 dimObj ) (vl-load-com) (setq acadObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument acadObj)) (setq modelSpace (vla-get-ModelSpace doc)) (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (setq i(ssget)))))) (setq ip (getbip ss)) (setq ip (vl-sort ip 'compare-points)) (setq n 0) (repeat (length ss) (setq p1 (vlax-3d-point(nth n ip))) (setq p2 (vlax-3d-point(nth (1+ n)ip))) (setq p3 (vlax-3d-point (polar (car ip)(+ (angle (car ip)(cadr ip))180.0)10))) (setq dimObj (vla-AddDimAligned modelSpace p1 p2 p3)) (setq n (1+ n)) ) ) (defun-q compare-points (a b / fuzz) (setq fuzz 1.0e-6) ;; comparison precision (if (equal (car a) (car b) fuzz) (if (equal (cadr a) (cadr b) fuzz) (> (caddr a) (caddr b)) (> (cadr a) (cadr b)) ) (> (car a) (car b)) ) ) (defun getbip (ss) (mapcar '(lambda (x) (cdr (assoc 10 (entget x))) ) ss) )
    1 point
  7. Not familiar with CADTools but have been customizing AutoCAD's interface for over 30 years. Why not just build a custom CUI referencing your lisp functions? I'd recommend loading them as needed with autoload or in the macro when the function is called. Plenty of us could help you with that.
    1 point
×
×
  • Create New...