All Activity
- Today
-
Danielm103 started following Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD and Extract Polyline Lengths with Associated Text Labels in AutoCAD
-
Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 replied to Tamim's topic in AutoLISP, Visual LISP & DCL
here's something in Python, if you can find anything in lisp -
Python, Extract Polyline Lengths with Associated Text Labels in AutoCAD
Danielm103 posted a topic in .NET, ObjectARX & VBA
sample of this import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs @Ap.Command() def doit(): try: # select db = Db.curDb() filter = [(Db.DxfCode.kDxfStart, "TEXT,LWPOLYLINE")] ps, ss = Ed.Editor.select(filter) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) texts = [Db.Text(id) for id in ss.objectIds(Db.Text.desc())] plines = [Db.Polyline(id) for id in ss.objectIds(Db.Polyline.desc())] # make kdtree & list of points pntmap = {} plpoints = [] for pl in plines: plpoints.append(pl.getStartPoint()) plpoints.append(pl.getEndPoint()) pntmap[pl.getStartPoint()] = pl pntmap[pl.getEndPoint()] = pl # search closest pline results = [] tree = Ge.Point3dTree(plpoints) for text in texts: idxs, _ = tree.knnSearch(text.position(), 1) pl: Db.Polyline = pntmap[plpoints[idxs[0]]] results.append([text.textString(), pl.getDistAtParam(pl.getEndParam())]) # format mtext results = sorted(results, key=lambda x: int(x[0][2:])) buffer = "{:<6}\t{}\\P".format("S.No", "Length Ft") buffer += "".join(f"{sno:<6}\t {plen:>.2f}\\P" for sno, plen in results) # make mtext, add to currentSpace ps, pnt = Ed.Editor.getPoint("\nPick Text Position") mt = Db.MText() mt.setDatabaseDefaults(db) mt.setLocation(pnt) mt.setContents(buffer) cs = db.currentSpace(Db.OpenMode.kForWrite) cs.appendAcDbEntity(mt) except Exception as err: traceback.print_exception(err) -
Can you explain that?
-
Tamim started following Extract Polyline Lengths with Associated Text Labels in AutoCAD
-
Extract Polyline Lengths with Associated Text Labels in AutoCAD
Tamim posted a topic in AutoLISP, Visual LISP & DCL
I have many polylines, and each one has a text label placed nearby (for example: “L-01” near a polyline with a length of 1.25 ft). I want a program that, once I select the polyline and its nearby text, automatically gives the result based on the text and the polyline’s length. I’ve attached the CAD file here ,please share the suitable program for this. Line Length Sample.dwg -
;;----------------------------=={ SmartPath }==-----------------------------;; ;; ;; ;; Creates a path connecting selected objects using various methods. ;; ;; Synthesized and enhanced by ajmalps, based on concepts from ;; ;; scripts by Kent Cooper, BlackBox, RJP, cab, and others. ;; ;; ;; ;; Command: SmartPath ;; ;; ;; ;;--------------------------------------------------------------------------;; ;; Date: August 6, 2025 (Fixed error handler on clean exit) ;; ;;--------------------------------------------------------------------------;; (vl-load-com) (defun c:SmartPath (/ *error* _get_midpoints _sort_nearest _sort_along_path _get_wire_settings doc ov_osmode ov_cmdecho sort_mode node_ss path_ent point_list sorted_list start_pt output_type layer) ;; --- CORRECTED Robust Error Handler --- (defun *error* (msg) (if ov_cmdecho (setvar 'CMDECHO ov_cmdecho)) (if ov_osmode (setvar 'OSMODE ov_osmode)) (if doc (vla-endundomark doc)) ;; Check if msg is a valid string before trying to process it (if (and msg (not (wcmatch (strcase msg t) "*CANCEL*,*QUIT*,*BREAK*"))) (princ (strcat "\nError: " msg)) ) (princ) ) ;; --- Helper: Get Center of Any Object's Bounding Box --- (defun _get_midpoints (ss / i ent vla_obj pt1 pt2 pt_list) (setq i 0) (repeat (sslength ss) (setq ent (ssname ss i)) (if (and (setq vla_obj (vlax-ename->vla-object ent)) (vlax-method-applicable-p vla_obj 'GetBoundingBox) ) (progn (vla-GetBoundingBox vla_obj 'pt1 'pt2) (setq pt_list (cons (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (vlax-safearray->list pt1) (vlax-safearray->list pt2)) pt_list)) ) ) (setq i (1+ i)) ) pt_list ) ;; --- Helper: Sort by Nearest Neighbor --- (defun _sort_nearest (pt_list / current_pt sorted_list closest_pt) (setq current_pt (car pt_list) pt_list (cdr pt_list) sorted_list (list current_pt)) (while pt_list (setq closest_pt (car pt_list)) (foreach pt (cdr pt_list) (if (< (distance current_pt pt) (distance current_pt closest_pt)) (setq closest_pt pt))) (setq current_pt closest_pt sorted_list (cons current_pt sorted_list) pt_list (vl-remove current_pt pt_list)) ) (reverse sorted_list) ) ;; --- Helper: Sort Along a Guide Path --- (defun _sort_along_path (path_ent pt_list / path_obj) (setq path_obj (vlax-ename->vla-object path_ent)) (mapcar 'cdr (vl-sort (mapcar '(lambda (pt) (cons (vlax-curve-getDistAtPoint path_obj (vlax-curve-getClosestPointTo path_obj pt)) pt)) pt_list) '(lambda (a b) (< (car a) (car b))))) ) ;; --- Helper for Custom Wire Settings --- (defun _get_wire_settings ( / temp_h temp_a) (if (not *wire_height*) (setq *wire_height* 5.0)) (if (not *wire_angle_deg*) (setq *wire_angle_deg* 15.0)) (setq temp_h (getdist (strcat "\nEnter chamfer height <" (rtos *wire_height*) ">: "))) (setq temp_a (getangle (strcat "\nEnter chamfer angle in degrees <" (rtos *wire_angle_deg*) ">: "))) (if temp_h (setq *wire_height* temp_h)) (if temp_a (setq *wire_angle_deg* (/ (* temp_a 180.0) PI))) (list *wire_height* *wire_angle_deg*) ) ;;============== Main Execution Starts Here ============== (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq ov_cmdecho (getvar 'CMDECHO) ov_osmode (getvar 'OSMODE)) (setvar 'CMDECHO 0) (initget "Nearest Path") (setq sort_mode (getkword "\nSelect sorting mode [Nearest/Path] <Nearest>: ")) (if (not sort_mode) (setq sort_mode "Nearest")) (cond ((= sort_mode "Nearest") (princ "\nSelect objects to connect: ") (if (and (setq node_ss (ssget '((0 . "~VIEWPORT")))) (setq start_pt (getpoint "\nPick point to start path from: ")) (setq point_list (_get_midpoints node_ss))) (setq sorted_list (_sort_nearest (cons start_pt point_list))) ) ) ((= sort_mode "Path") (princ "\nSelect guide path (line, pline, spline, etc.): ") (if (and (setq path_ent (car (entsel))) (princ "\nSelect objects to connect: ") (setq node_ss (ssget '((0 . "~VIEWPORT")))) (setq point_list (_get_midpoints node_ss))) (setq sorted_list (_sort_along_path path_ent point_list)) ) ) ) (if sorted_list (progn (initget "Polyline Line Arc Spline Wire") (setq output_type (getkword "\nSelect output type [Polyline/Line/Arc/Spline/Wire] <Polyline>: ")) (if (not output_type) (setq output_type "Polyline")) (setq layer (getstring (strcat "\nEnter layer for path <" (getvar "CLAYER") ">: "))) (if (= "" layer) (setq layer (getvar "CLAYER"))) (setvar 'OSMODE 0) (princ (strcat "\nDrawing " output_type "...")) (cond ((= output_type "Polyline") (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline")) (list (cons 8 layer) (cons 90 (length sorted_list)) '(70 . 0)) (mapcar '(lambda (pt) (cons 10 pt)) sorted_list))) ) ((= output_type "Line") (mapcar '(lambda (p1 p2) (entmakex (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))) sorted_list (cdr sorted_list)) ) ((= output_type "Arc") (mapcar '(lambda (p1 p2 / ptm) (setq ptm (polar (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)) (+ (angle p1 p2) (/ PI 2.0)) (* (distance p1 p2) 0.18))) (command "_.ARC" "_none" p1 "_none" ptm "_none" p2) (if (entlast) (command "_.CHPROP" (entlast) "" "_LA" layer ""))) sorted_list (cdr sorted_list)) ) ((= output_type "Wire") (progn (setq settings (_get_wire_settings) w_height (car settings) w_ang_deg (cadr settings) w_ang_rad (/ (* w_ang_deg PI) 180.0)) (mapcar '(lambda (p_start p_end / offset_start offset_end) (setq offset_start (polar p_start (+ (angle p_start p_end) w_ang_rad) w_height) offset_end (polar p_end (- (angle p_end p_start) w_ang_rad) w_height)) (entmakex (list '(0 . "LWPOLYLINE") (cons 8 layer) '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 0) (cons 10 p_start) (cons 10 offset_start) (cons 10 offset_end) (cons 10 p_end))) ) sorted_list (cdr sorted_list) ) ) ) ((= output_type "Spline") (entmakex (append '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")) (list (cons 8 layer) '(70 . 8) '(71 . 3) (cons 72 (length sorted_list)) (cons 73 (length sorted_list)) '(74 . 0)) (mapcar '(lambda (pt) (cons 11 pt)) sorted_list))) ) ) (princ " Done.") ) (princ "\nPath creation cancelled or no valid objects found.") ) (*error* nil) ) (princ "\n:: SmartPath.lsp loaded. Command: SmartPath ::") (princ) try this
- Yesterday
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
BIGAL replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
What may speed up the process as well as processing each line individually as suggested is to open the CSV in say notepad and subtly add a "," replacing the (( and )) so the csv becomes more a pattern, I would also change the "-22" to ",-22" again makes the lat and long 2 separate items removing an extra split required in code. This way run Lee-mac string to list and it will split all line values into a single list. I agree process each line via a read, Just read the 1st line as a dummy read removing header info. Then use (while read-line for rest of csv. -
mhupp started following PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
mhupp replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
if that's the only thing your using doslib for use acet-ui-progress instead. ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (setq campos (LM:str->lst linha delimitador)) I would say most of your time is in FTTx:Geo->UT and vl-string-trim (setq tipo (vl-string-trim " " (nth 4 campos))) ;why trim (setq titulo (vl-string-trim " " (nth 5 campos))) ;why trim (setq nome (vl-string-trim " " (nth 6 campos))) ;why trim (setq endereco (vl-string-trim " " (strcat tipo " " titulo " " nome))) ;to then add spaces to trim again? fixed to (setq endereco (vl-string-trim " " (strcat (nth 4 campos) (nth 5 campos) (nth 6 campos)))) ;just remove almost 34k vl-string-trim -
Copy and paste error (blocks changes!)
rlx replied to X11start's topic in AutoLISP, Visual LISP & DCL
Since we're all going off topic (thanks a lot Bigal) , might as well join the band. Added the 'check before paste' lisp to my toolbar. Not sure if I'm ever gonna use it but that wasn't the point, was working on a way to make it a little more easier for myself to update the toolbars for my colleagues (the old last century toolbars , you oldies know what I mean) so lazy as I am , created a button for that too. It hasn't been field tested though so it may or may not work at all... New for me was the help part. Never used html in my life before and also read-write stream only used a couple of times (to create a few .bmp files for the toolbar by means of lisp , look for the Party button) So lets party yeah! euh ...the button I mean , what I mean by that , read the .... manual (oh just press the darn help button) Easy_Toolbar_Creator.lsp -
Instead of perpendiculars: why not try it with... ...bisectors?
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
JuniorNogueira replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
@devitg this is just the doslib progress bar, you can remove it from the code and it won't make any difference -
that gread only updates when you move your mouse. so i guess its just in there for testing/visualization. couldn't imagine having to wiggle the mouse to get commands to complete.
-
devitg started following PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
devitg replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
@JuniorNogueira another defun is miss ; error: no function definition: DOS_GETPROGRESS Please check for other miss defun. -
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
JuniorNogueira replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
;pt -> long lat ;a -> semi eixo maior ;f -> achatamento (defun FTTx:Geo->UT (pt a f / b e el el² c lamb fi fuso lo deltal Am eps n v S A1 A2 J2 J4 J6 alfa beta gama bo) (gc) (setq a (float a) b (- a (/ a f)) el (/ (sqrt (- (expt a 2) (expt b 2))) b) el² (expt el 2) c (/ (expt a 2) b) fuso (fix (+ (/ (car pt) 6.0) 31)) lamb (/ (* (car pt) pi) 180.0) fi (/ (* (cadr pt) pi) 180.0) lo (- (* fuso 6) 183) ;meridiano central deltal (- lamb (/ (* lo pi) 180.0)) Am (* (cos fi) (sin deltal)) eps (* 0.5 (log (/ (+ 1 Am) (- 1 Am)))) n (- (atan (/ (tan fi) (cos deltal))) fi) v (/ (* c 0.9996) (sqrt (+ 1 (* el² (expt (cos fi) 2))))) S (/ (expt (* el eps (cos fi)) 2) 2.0) A1 (sin (* 2.0 fi)) A2 (* A1 (expt (cos fi) 2.0)) J2 (+ fi (/ A1 2.0)) J4 (/ (+ (* 3.0 J2) A2) 4.0) J6 (/ (+ (* 5 J4) (* A2 (expt (cos fi) 2))) 3.0) alfa (/ (* 3.0 el²) 4.0) beta (* (/ 5.0 3.0) (expt alfa 2)) gama (* (/ 35.0 27.0) (expt alfa 3)) bo (* 0.9996 c (+ fi (* (- alfa) J2) (* beta J4) (* (- gama) J6)))) (list (+ 500000.0 (* eps v (1+ (/ S 3.0)))) ;x (+ bo (* n v (1+ S)) (if (< lat 0.0) 10000000.0 0.0));y (caddr pt) ) ) (defun tan (ang) (/ (sin ang) (cos ang)) ) -
I tracked the issue, pretty much what @mhupp stated, it just does it different depending on selection 1 and selection 2. I think at least part of that issue was using vlax-curve-getPointAtDist and/or vlax-curve-getClosestPointTo changes according to the first selection. Normally good enough for most people. I made headway trying to get the LISP working similar to your manual method, it's fairly good, the main issue is on some polylines, even with your method an actual decision on what is the best line(s) at certain spots is needed. The new LISP I worked on, seems to be pretty good no matter the selection order on all but the long rectangle shape. Working or not, I might go ahead and post what I have Monday when I return to work. I worked out manually why selection order on the one with the straight through the corner and reverse selection there is a little dogleg shape, there is a decision to be made there, I did it both ways and matched mine and Lee Mac's shape. It will be Monday when I get back to work before I have time to keep testing. I wish I had found Lee Mac's code, somehow I missed that one. I would have never made mine, for some reason those rolling ball LISPs never worked out very well for me.
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
GLAVCVS replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
PS' It is not possible to fully test the functionality of your code because the "fftx:geo->utm" function is missing. -
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
GLAVCVS replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
So you don't need to create a list of each line of the file. If the file is large, it will waste a lot of time and consume resources. Simply load each line of the file directly as it's read. -
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
JuniorNogueira replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
@GLAVCVS I didn't do it this way just to treat the header. -
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
GLAVCVS replied to JuniorNogueira's topic in AutoLISP, Visual LISP & DCL
Hi Is there any reason why the CSV file needs to be uploaded in reverse order? -
Why there is deviation depending on selection order at least for mine. the lisp looks for the poly that has the most vertx and uses that to calculate points off of. if the polylines have the same number the it goes by selection order. I suspect all of these lisps fall short because the points are only being calculated from poly1 to poly2. were your manual way the other half of the points are need from poly2 back to poly1. So you need to run it twice get all the vertx mid points from p1 closest to p2 get all the vertx mid points from p2 closest to p1 The hard part the hard part is then puting them in the right order to draw the mid polyline correctly. im setting the first point and then getting the closest point, should work for what you want to do but could give 0 length segments or out of order. -edit added in @SLW210 test if for selecting polylines ;;----------------------------------------------------------------------------;; ;; POLY AVERAGE between polylines, Finds the mid point avg between close polylines donut shape (defun c:CLOSEPOLYAVG (/ sel1 sel2 ent1 ent2 i ptv ptc mid pts polylst) (setq ent1 (car (entsel "\nSelect first polyline: "))) (if (not (and ent1 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE"))) (progn (princ "\nInvalid 1st selection.") (exit)) (setq ent1 (vlax-ename->vla-object ent1)) ) (setq ent2 (car (entsel "\nSelect 2nd polyline: "))) (if (not (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE"))) (progn (princ "\nInvalid first selection.") (exit)) (setq ent2 (vlax-ename->vla-object ent2)) ) (if (and ent1 ent2) (progn (setq pts '()) (setq i 0) (while (<= i (fix (vlax-curve-getEndParam ent1))) (setq ptv (vlax-curve-getPointAtParam ent1 i)) (setq ptc (vlax-curve-getClosestPointTo ent2 ptv)) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts (append pts (list mid))) (setq i (1+ i)) ) (setq i 0) (while (<= i (fix (vlax-curve-getEndParam ent2))) (setq ptv (vlax-curve-getPointAtParam ent2 i)) (setq ptc (vlax-curve-getClosestPointTo ent1 ptv)) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts (append pts (list mid))) (setq i (1+ i)) ) (setq polylst (sortpts pts)) (setq Flag (if (= (vla-get-Closed ent1) :vlax-true) 1 0)) ; Get closed status (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)) (cons 70 flag) ) (mapcar '(lambda (p) (cons 10 p)) polylst) ) ) (princ "\nNew midpoint polyline created.") ) (princ "\nSelection error.") ) (princ) ) (defun c:CPA () (C:CLOSEPOLYAVG)) (defun sortpts (pointlist / pts-sort current next) (setq pts-sort (list (car pointlist))) ; Start with first point (setq pointlist (cdr pointlist)) ; Remove it from list as (while pointlist (setq current (last pts-sort)) ; Get last point in sorted (setq next (car (vl-sort pointlist (function (lambda (a b) (< (distance current a) (distance current b)) ) ) ) ) ) (setq pointlist (vl-remove next pointlist)) ; Remove selected point (setq pts-sort (append pts-sort (list next))) ; Add to sorted list ) pts-sort ) -edit follows your rough but there is one place it deviates a little since your line is longer (left side)
-
JuniorNogueira started following PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
-
PERFORMANCE ISSUE WITH READ-LINE ON LARGE CSV FILES
JuniorNogueira posted a topic in AutoLISP, Visual LISP & DCL
I'm experiencing a performance issue when processing very large CSV files. My code works correctly, but when I work with large datasets, reading becomes extremely slow. I suspect the read-line method may be the main bottleneck. Does anyone have suggestions on how to optimize this operation? I've attached an example of the CSV I'm using for reference. The file has approximately 10,993 rows. Has anyone experienced a similar situation or have tips for improving performance when reading massive CSV files? I appreciate any help! ;; ===== IMPORTAÇÃO DE QUADRAS COM TEXTO CENTRALIZADO, ROTACIONADO E DESLOCADO ===== (defun c:arruamentos-ultra-turbo ( / delimitador patharquivo doc modelSpace linhas file linha coord_str lista_pontos endereco old_cmdecho old_highlight start_time end_time elapsed_time count-total count-valid count-poly debug-limit pares xy campos tipo titulo nome texto_pt texto_obj) (setq old_cmdecho (getvar "CMDECHO") old_highlight (getvar "HIGHLIGHT") start_time (getvar "MILLISECS") count-total 0 count-valid 0 count-poly 0) (setvar "CMDECHO" 0) (setvar "HIGHLIGHT" 0) (command "_.UNDO" "_Begin") (setq delimitador ";") (setq patharquivo (getfiled "Selecione .CSV" (getvar 'DWGPREFIX) "csv" 16)) (if patharquivo (progn (princ "\nLendo arquivo...") (setq file (open patharquivo "r") linhas '()) (while (setq linha (read-line file)) (if (and linha (/= linha "")) (setq linhas (cons linha linhas)) ) ) (close file) (setq linhas (cdr (reverse linhas))) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq modelSpace (vla-get-ModelSpace doc)) (dos_getprogress "FTTx - Importando Quadras" "Por favor, aguarde..." (length linhas)) (foreach linha linhas (setq count-total (1+ count-total)) (dos_getprogress -1) (setq campos (fttx:str->lst-rapido linha delimitador)) (if (>= (length campos) 7) (progn (setq coord_str (vl-string-subst "" "\"" (nth 0 campos))) (setq tipo (vl-string-trim " " (nth 4 campos))) (setq titulo (vl-string-trim " " (nth 5 campos))) (setq nome (vl-string-trim " " (nth 6 campos))) (setq endereco (vl-string-trim " " (strcat tipo " " titulo " " nome))) (if (and coord_str (wcmatch coord_str "MULTILINESTRING (*")) (progn (setq coord_str (vl-string-subst "" "MULTILINESTRING ((" coord_str)) (setq coord_str (vl-string-subst "" "))" coord_str)) (setq pares (fttx:str->lst-rapido coord_str ",") lista_pontos '()) (foreach par pares (setq xy (fttx:str->lst-rapido (vl-string-trim " " par) " ")) (if (= (length xy) 2) (setq lista_pontos (cons (list (read (car xy)) (read (cadr xy)) 0.0) lista_pontos)) ) ) (if (and lista_pontos (> (length lista_pontos) 1)) (progn (setq count-valid (1+ count-valid)) (setq lista_pontos (reverse lista_pontos)) (if (criar-polilinha-rapida lista_pontos modelSpace) (progn (setq count-poly (1+ count-poly)) (criar-texto-no-meio endereco lista_pontos modelSpace) ) ) ) ) ) ) ) ) ) (dos_getprogress t) (setq end_time (getvar "MILLISECS") elapsed_time (/ (- end_time start_time) 1000.0)) (princ (strcat "\nImportação finalizada." "\n - Linhas totais: " (itoa count-total) "\n - Coordenadas válidas: " (itoa count-valid) "\n - Polilinhas criadas: " (itoa count-poly) "\n - Tempo: " (rtos elapsed_time 2 2) "s")) ) (princ "\n⚠ Nenhum arquivo selecionado.") ) (command "_.UNDO" "_End") (setvar "CMDECHO" old_cmdecho) (setvar "HIGHLIGHT" old_highlight) (princ) ) (defun criar-polilinha-rapida (lista_pontos modelSpace / objArray n idx lista_pontosutm) (setq lista_pontosutm (mapcar '(lambda (p) (fttx:geo->ut p 6378160.0 298.25)) lista_pontos ) ) (setq n (* 2 (length lista_pontosutm))) (if (> n 0) (progn (setq objArray (vlax-make-safearray vlax-vbDouble (cons 0 (1- n))) idx 0) (foreach p lista_pontosutm (vlax-safearray-put-element objArray idx (car p)) (vlax-safearray-put-element objArray (1+ idx) (cadr p)) (setq idx (+ idx 2)) ) (vla-AddLightWeightPolyline modelSpace (vlax-make-variant objArray)) T ) nil ) ) (defun criar-texto-no-meio (conteudo pts modelSpace / pt1 pt2 mid ang offset_pt txtobj) ;; pegar primeiro e último ponto para orientação e centro (setq pt1 (fttx:geo->ut (car pts) 6378160.0 298.25)) (setq pt2 (fttx:geo->ut (last pts) 6378160.0 298.25)) (setq mid (list (/ (+ (car pt1) (car pt2)) 2.0) (/ (+ (cadr pt1) (cadr pt2)) 2.0) 0.0)) (setq ang (angle pt1 pt2)) ;; deslocamento de 1m perpendicular ao segmento (setq offset_pt (list (+ (car mid) (* 2.0 (sin ang))) (- (cadr mid) (* 2.0 (cos ang))) 0.0)) (setq txtobj (vla-AddText modelSpace conteudo (vlax-3d-point offset_pt) 1.5)) (vla-put-Rotation txtobj ang) (vla-put-Alignment txtobj acAlignmentMiddleCenter) (vla-put-TextAlignmentPoint txtobj (vlax-3d-point offset_pt)) txtobj ) (defun fttx:calcular-centroide (pts / x y n) (setq x 0 y 0 n 0) (foreach p pts (setq x (+ x (car p)) y (+ y (cadr p)) n (1+ n))) (if (> n 0) (list (/ x n) (/ y n) 0.0) '(0.0 0.0 0.0) ) ) (defun fttx:str->lst-rapido (str del / pos len result chunk) (if (and str del) (progn (setq len (1+ (strlen del))) (while (setq pos (vl-string-search del str)) (setq chunk (substr str 1 pos)) (if (> (strlen chunk) 0) (setq result (cons chunk result))) (setq str (substr str (+ pos len))) ) (if (> (strlen str) 0) (setq result (cons str result))) (reverse result) ) ) ) ourinhos.csv -
I've attached a small example drawing. I've tried all the codes: @roy437, @Lee Mac, @mhupp and @SLW210 The SLW's code seems to return the same result as Lee Mac's. I've run each command twice, changing the selection order of the polylines, and saved the result in a single layer. As you can see, none of them return the same axis when the selection order is changed. Also, in some turns, there are significant deviations from the "real" axis. The problem is that my manual method also doesn't capture the real axis, although it's quite close, and in some turns, it also deviates slightly. My axis is also drawn (in the red rectangles) on the "myaxis" layer, and I've left the perpendiculars I used to calculate it in green. AxisExample.dwg
-
mhupp started following Copy and paste error (blocks changes!)
-
Copy and paste error (blocks changes!)
mhupp replied to X11start's topic in AutoLISP, Visual LISP & DCL
Just a side note sort has some other funky quirks with "sorting" As shown in @BIGAL's example of (bubblesort a) were 127 is before 27 and 3 Even windows explorer does this also. I don't know what kinda of strings your working with but maybe consider using fixed numbering showing them in the correct order ("001" "001" "003" "027" "122" "54b" "A34") Tho if these are block names that is no good because 001 <> 1. Maybe convert your list into dotted pairs this would keep all unique values and a running count (defun C:foo ( / test lst item) (setq test '("1" "2" "3" "3" "1" "2" "2" "1" "3" "1" "3" "1")) (setq lst '()) ; initialize empty list (foreach str test (setq item (assoc str lst)) ; check if str is in lst (if item (setq lst (subst (cons str (+ (cdr item) 1)) item lst)) ; update count (setq lst (cons (cons str 1) lst)) ; add new string with count 1 ) ) (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))) ;sorts lst by car of dotted pair (princ "\nCounts:") (foreach itm lst (princ (strcat "\n" (car itm) ": " (itoa (cdr itm)))) ) (princ) ) -
Copy and paste error (blocks changes!)
X11start replied to X11start's topic in AutoLISP, Visual LISP & DCL
Thanks BIGAL: I overcame the problem by using VL-SORT-I: (setq lst '("2" "1" "3" "1")) (mapcar '(lambda (x) (nth x lst))(vl-sort-i lst '<)) the result is: ("1" "1" "2" "3") For completeness, I also refer to a post where I was looking for a way to arrange elements according to various criteria. HERE ... but the VL-SORT mentioned in this post was only to illustrate that GStarCAD sometimes behaves strangely, or even just differently from AutoCAD. Thank you anyway for your interest: it’s always great when experienced users take the time to understand other people's problems! -
InsideThreads How do I Place Very large threads?
SLW210 replied to gbradley's topic in Autodesk Inventor
You'll need to make it. C:\Users\Public\Documents\Autodesk\Inventor <version>\Design Data\XLS and modify the Threads.xls, you might need to also alter the Clearance.xls, be sure to Save the originals some where, I usually just Saves and add _Original to the name. It's been a while since I used Inventor, but pretty sure it's just the case of adding the new information, make sure they are saved to correct location and are correctly named Threads.xls and Clearance.xls, when you restart Inventor they should be there. -
How to draw the 3d block shown in the image sent?
oddssatisfy replied to hemal's topic in AutoCAD 3D Modelling & Rendering
To draw the 3D model from the upside-down Fig 15.47, start by identifying its basic shapes and overall structure. Sketch the largest shape first, adjust for the correct orientation, and use perspective lines to position the shapes in 3D space. Then add smaller details, edges, and curves, and finish by darkening final lines and adding shading for depth.
