Leaderboard

Here's my take. ;; cone_batter by ymg ; ;; ; ;; Note that ssb remains global and is the selection set of batters, ; ;; At a selection prompt enter !ssb ; ;; ; ;; Prog requires function midpoint. ; ;; ; (defun c:cone_batter (/ ent1 ent2 p1 p2 cum1 cum2 len1 len2 n_bat n i) (setq ent1 (car (entsel "\n Select a TOP polyline: ")) ent2 (car (entsel "\n Select a BOTTOM polyline: ")) n_bat (getint "\n How many batter tics: ") n (+ 1 n_bat) ) (setq len1 (/ (vlax-curve-getdistatparam ent1 (vlax-curve-getendparam ent1)) n) len2 (/ (vlax-curve-getdistatparam ent2 (vlax-curve-getendparam ent2)) n) cum1 0.0 cum2 0.0 i 0 ssb (ssadd) ) (repeat (+ n 1) (setq p1 (vlax-curve-getPointAtDist ent1 cum1) p2 (vlax-curve-getPointAtDist ent2 cum2) ) (if (zerop (rem i 2)) (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))) (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 (midpoint p1 p2)))) ) (ssadd (entlast) ssb) (setq cum1 (+ cum1 len1) cum2 (+ cum2 len2) i (+ i 1) ) ) ) ;; Function midpoint by ymg ; ;; Returns the midpoint between 2 points. ; (defun midpoint (a b) (polar a (angle a b) (* (distance a b) 0.5))) ymg cone_batter.lsp

Al revisar el archivo adjunto que compartió, noto que solo contiene una tabla con una descripción del equipo. Sin embargo, he observado que el equipo número 2 y el número 6 son idénticos. Si tu objetivo es identificar textos que sean exactamente iguales, puedes utilizar la siguiente rutina. En la primera selección se te pedirá que elijas el texto a identificar, o simplemente presionar enter para ingresarlo manualmente, mientras que en la segunda selección deberás seleccionar en una ventana los posibles textos duplicados. Al final, los textos idénticamente duplicados permanecerán seleccionados. En mi opinión esta estrategia es más práctica que unir los textos con una línea o polilínea. ;Select similar identical text v 1.0 ;Romero... March 2024 (defun C:SST ( / s1 obj lst s2 str) (princ "\nSelect the text string or enter to indicate manually :") (if (or (if (setq s1 (cadr (ssgetfirst))) (setq str (if (= 1 (sslength s1)) (cdr (assoc 1 (entget (ssname s1 0)))) (car (sssetfirst nil nil)) ) ) ) (if (setq s1 (car (entsel))) (setq str (cdr (assoc 1 (entget s1)))) ) (/= (setq str (getstring t "\nEnter the text to select: ")) "") (setq str "*") ) (progn (princ "\nSelect the other text objects...") (sssetfirst nil nil) (setq flst (list '(0 . "*TEXT") (cons 1 str))) (if (setq s2 (ssget (list '(0 . "*TEXT") (cons 1 str)))) (princ (strcat (itoa (sslength s2)) " objects")) ) (cadr (sssetfirst nil s2)) ) ) (if (zerop (getvar 'cmdactive)) (princ) (cadr (sssetfirst nil s2))) )

I was thinking of doing the same thing but with bpoly. Only problem it could give false positives if the point is outside the original polyline but still inside another closed polyline or area.

Your python solutions are increasing maybe make a doc of what they all do with some images no code. This needs updating. Lisp files June 2023.docx

does just comment out the last line fix the issue so not (c:lrn) but ;(c:lrn) this will prevent the routine from running automatically

@Lee: You know, in retrospect, I don't know why I fooled with changing it to VL just to change the name. Brain wasn't screwed on all the way that day and all I did as a revision was clean up the code. I decided to update mine to exclude the unneeded use of VL and to give the option to edit the current layer - something I've been meaning to add any way. (defun c:RenL (/ ent old new lay) ;; Rename Layer of Selected Object or current layer ;; Required Subroutines: AT:Getstring ;; Alan J. Thompson, 11.30.09 / 05.21.13 (while (progn (setvar 'ERRNO 0) (initget 0 "Current") (setq ent (entsel "\nSelect object on layer to change name [Current]: ")) (if (eq (getvar 'ERRNO) 7) (princ "\nMissed, try again.") ) ) ) (cond ((not ent)) ((member (setq new (AT:Getstring "Specify new layer name:" (if (eq (type ent) 'STR) (cdr (assoc 2 (setq lay (entget (tblobjname "LAYER" (setq old (getvar 'CLAYER))) ) ) ) ) (cdr (assoc 2 (setq lay (entget (tblobjname "LAYER" (setq old (cdr (assoc 8 (entget (car ent))))) ) ) ) ) ) ) ) ) (list "" nil old) ) ) ((tblsearch "LAYER" new) (alert (strcat "Layer: \"" new "\" already exists!"))) ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!"))) ((entmod (subst (cons 2 new) (assoc 2 lay) lay)) (alert (strcat "Layer: " old " renamed to: " new)) ) ((alert (strcat "Layer: " old " could not be renamed to: " new))) ) (princ) ) (defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString) ;; Getstring Dialog Box ;; #Title - Title of dialog box ;; #Default - Default string within edit box ;; Alan J. Thompson, 08.25.09 (setq #FileName (vl-filename-mktemp "" "" ".dcl") #FileOpen (open #FileName "W") ) (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";" "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;" "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {" "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}" "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {" "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//" ) (write-line x #FileOpen) ) (close #FileOpen) (setq #DclID (load_dialog #FileName)) (new_dialog "TempEditBox" #DclID) (set_tile "Title" #Title) (set_tile "Edit" #Default) (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog #DclID) (vl-file-delete #FileName) #NewString )

(defun c:RenL (/ ent old new) ;; Rename Layer of Selected Object ;; Required Subroutines: AT:Getstring ;; Alan J. Thompson, 11.30.09 / 05.21.13 (while (progn (setvar 'ERRNO 0) (setq ent (car (entsel "\nSelect object on layer to change name: "))) (if (eq (getvar 'ERRNO) 7) (princ "\nMissed, try again.") ) ) ) (cond ((not ent)) ((member (setq new (AT:Getstring "Specify new layer name:" (setq old (cdr (assoc 8 (entget ent)))))) (list "" nil old) ) ) ((tblsearch "LAYER" new) (alert (strcat "Layer: \"" new "\" already exists!"))) ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!"))) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-put-name (list (vlax-ename->vla-object (tblobjname "LAYER" old)) new) ) ) (alert (strcat "Layer: " old " could not be renamed to: " new)) ) ((alert (strcat "Layer: " old " renamed to: " new))) ) (princ) ) (defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString) ;; Getstring Dialog Box ;; #Title - Title of dialog box ;; #Default - Default string within edit box ;; Alan J. Thompson, 08.25.09 (setq #FileName (vl-filename-mktemp "" "" ".dcl") #FileOpen (open #FileName "W") ) (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";" "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;" "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {" "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}" "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {" "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//" ) (write-line x #FileOpen) ) (close #FileOpen) (setq #DclID (load_dialog #FileName)) (new_dialog "TempEditBox" #DclID) (set_tile "Title" #Title) (set_tile "Edit" #Default) (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog #DclID) (vl-file-delete #FileName) #NewString )

Here's one I use on a regular basis: (defun c:Clone (/ ent layer name) ;; Clone selected object's layer ;; Required subroutine: AT:GetString ;; Alan J. Thompson, 02.09.11 (setvar 'ERRNO 0) (if (while (and (not ent) (/= 52 (getvar 'ERRNO))) (initget 0 "Current") (setq ent (entsel "\nSelect object on layer to clone [Current]: ")) ) (cond ((not (setq name (AT:GetString "Specity clone layer name:" (setq layer (if (eq (type ent) 'STR) (getvar 'CLAYER) (cdr (assoc 8 (entget (car ent)))) ) ) ) ) ) ) ((not (snvalid name)) (alert "Invalid name!")) ((apply (function eq) (mapcar (function strcase) (list name layer))) (alert "Clone layer cannot have same name as base layer!") ) ((tblsearch "LAYER" name) (alert "Layer already exist!")) ((entmake (append (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) ) (vl-remove-if-not (function (lambda (x) (vl-position (car x) '(6 62 70 270 370)))) (entget (tblobjname "LAYER" layer)) ) ) ) (alert (strcat "Layer \"" layer "\" has been cloned to create layer: \"" (setvar 'CLAYER name) "\"" ) ) ) ) ) (princ) ) (defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString) ;; Getstring Dialog Box ;; #Title - Title of dialog box ;; #Default - Default string within edit box ;; Alan J. Thompson, 08.25.09 (setq #FileName (vl-filename-mktemp "" "" ".dcl") #FileOpen (open #FileName "W") ) (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";" "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;" "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {" "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}" "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {" "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//" ) (write-line x #FileOpen) ) (close #FileOpen) (setq #DclID (load_dialog #FileName)) (new_dialog "TempEditBox" #DclID) (set_tile "Title" #Title) (set_tile "Edit" #Default) (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog #DclID) (vl-file-delete #FileName) #NewString )