Leaderboard

Do a presort like so to speed this up. This took ~5s to process 130,000 lines. (defun c:foo (/ a b c e f n r s) ;; RJP » 2022-04-14 ;; Groups a list of lists of lines that have similar angles and lengths (setq f 1e-1) (cond ((setq s (ssget '((0 . "LINE")))) (setq s (mapcar '(lambda (e) (setq a (vlax-curve-getstartpoint e)) (setq b (vlax-curve-getendpoint e)) (list (rem (angle a b) pi) (distance a b) e) ) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) ) ) ;; Presort by sum of angle and length (setq s (vl-sort s (function (lambda (r j) (< (+ (cadr r) (car r)) (+ (cadr j) (car j))))))) ;; While we have a list (while (setq a (car s)) ;; Remove first item (setq s (cdr s)) ;; Reset temp list (setq c nil) ;; Add first item to temp list 'c' (setq c (cons a c)) ;; While we have a list 's' and the angle and length is 'equal', compile temp list 'c' (while (and s (equal (car a) (caar s) f) (equal (cadr a) (cadar s) f) (setq c (cons (car s) c)) (setq s (cdr s)) ) ) ;; Result (setq r (cons c r)) ) ;;; (setq n 0) ;;; ;; Quick check ;;; (foreach l r ;;; (setq n (1+ n)) ;;; (foreach e l (entmod (append (entget (last e)) (list (cons 62 n))))) ;;; ) ) ) (princ) )

@ekko Redownload the code .. I had forgotten to reset the temp list which gives very incorrect results.

That is exactly a question I wanted to ask today I use Graebert ares for planning electrical projects and I could use the custom blocks (like dynamic blocks in acad) to switch through various options I can preconfigure in the blocks like rotation, alignment and base points. The problem is when the block is in the drwaing Id have to insert them again or copy and then change these things in properties. A Program that reads the selected block name and inserts it, so I have it on handle would make a much nicer workflow. Ok, I see you want to copy the blocks name... If anyone has a simple program for the example I wrote, that would be nice!

Glad to help If you compile the code it should be even faster... Yup .. over 2x

Try this way too (defun c:testthis ( / ) (setq NewText (vla-get-effectivename (vlax-ename->vla-object (car (entsel "\nSelect block: ")))) ) (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" NewText ) )

A value of 180 degrees or more in the expression for parallelism is equivalent to -180 degrees. It is easily solved by putting a single if statement in front of it. In this process you will be able to purge decimal errors by rounding off. because lwpolyline can have multiple vertices, so check whether the object is a line or an lwpolyline, and if it is an lwpolyline, check if it has only two points, and if both conditions are passed, calculate the angle and put it in the list. An easy way to solve this is to explode and treat them all as lines.

You should run the calculations on the list building a new list with the answers. This way your only doing the calculations once and in the loops your only pulling values. (foreach e lst (setq l (cons (list e ang len) l)) ) ;;;ent angle (defun ang (e) (vlax-get-property (EtoO e) 'angle) ) Would turn (<Entity name: 4ecbaf20> <Entity name: 4ecba4e0>) into ((<Entity name: 4ecbaf20> 30 1.26) (<Entity name: 4ecba4e0> 60 2.33)) if the angles are the same then they are parallel (if (and (=\ (cadr x) (cadr e)) (equal (caddr x) (caddr e) 1)) (if (and (=\ (30) (60)) (equal (1.26) (2.33) 1)) t

sorry misunderstood.

Use THIS.

(defun c:pdf( / activelayout ctbname pdgsccpaper pdgsccpapera4 P_plotername P_papername PATH PDFdelay pppscaleonfit pltovrd mmmvorder mmmvhide *error* ent pwgs ss1 ppw1 ppw2 vpw1 vpw2 pwwsel pdgscc1 pdgscc pdgscc4 wlp) (vl-load-com) ;activate vl code (setq pdgsccpaper 514.4016); a3 paper length, if pppscaleonfit is "FIT", this lisp is not use this variable (setq pdgsccpapera4 363.7430); a4 paper length, if pppscaleonfit is "FIT", this lisp is not use this variable (setq activelayout (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))) ;get active layout for get batch plot settings (setq p_plotername (vl-string-translate "_" " " (vla-get-ConfigName activelayout))) ;get plotter name (setq p_papername (vl-string-translate "_" " " (vla-get-CanonicalMediaName activelayout))) ;get paper name (setq ctbname (vla-get-StyleSheet activelayout)) ;get ctb name (setq path (getvar "dwgprefix")) ;get dwg file's folder (setq PDFdelay 3000) ;for make sure spooling pdf. (setq answer (getstring (strcat "\n\n Plotter - " P_plotername " / Paper - " P_papername " / CTB - " ctbname "\n Press Any Key to RUN, For Changing Plot Setting Press ESC then Edit Plot setting in PLOT (CTRL+P) then Save as Batch \n "))) (setq pppscaleonfit "fit"); fit to paper (setq pltovrd 1); set PLOTTRANSPARENCYOVERRIDE for transparent hatch is 2, default is 1 (setq mmmvorder "N"); Layout Tab first is Y, Model Tab first is N (setq mmmvhide "N"); Layout Tab object hiding is Y, or no is N ; error control (defun *error* (msg) (princ "error: ") (princ msg) (setvar "osmode" 0) (princ) ) (setq ent nil) (prompt "\n Select Title Blocks for Prints. (made by block)" ) (setq pwgs (ssget (list (cons 0 "insert")))) ; these 2 modules for modified UCS dwg. ;; Doug C. Broad, Jr. ;; can be used with vla-transformby to ;; transform objects from the UCS to the WCS (defun UCS2WCSMatrix () (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 1 0 t) (list origin)) ); end of lambda (list '(1 0 0) '(0 1 0) '(0 0 1)) (trans '(0 0 0) 0 1) ); end of mapcar (list '(0 0 0 1)) ); end of append ); end of vlax-tmatrix ); end of defun ;; transform objects from the WCS to the UCS (defun WCS2UCSMatrix () (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 0 1 t) (list origin)) ); end of lambda (list '(1 0 0) '(0 1 0) '(0 0 1)) (trans '(0 0 0) 1 0) );end of mapcar (list '(0 0 0 1)) ); end of append ); end of vlax-tmatrix ); end of defun (if pwgs (progn (setq ss1 (SortSelectionSetByYXZ pwgs)) (setq n 0) (repeat (sslength ss1) (setq ent (ssname ss1 n)) ; these 3 lines is for modified UCS dwg. (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix)) (vla-getboundingbox (vlax-ename->vla-object ent) 'MinPt 'MaxPt) (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix)) (setq ppw1 (vlax-safearray->list MinPt)) (setq ppw2 (vlax-safearray->list MaxPt)) (setq vpw1 (list (car ppw2) (cadr ppw1))) ; lower-right point (setq vpw2 (list (car ppw1) (cadr ppw2))) ; upper-left point (setq wx (- (car ppw2) (car ppw1)) ) ; length of width (setq wy (- (cadr ppw2) (cadr ppw1)) ) ; length of height (if (> wx wy) (setq wlp "l") (setq wlp "p")) ; landscape or portrait (setq pwwsel (ssget "W" ppw1 ppw2 )) ; all drawing (setq pdgscc1 (distance ppw1 ppw2)) (setq pdgscc (/ pdgscc1 pdgsccpaper )) ; scaling to a3 drawing (if title block is not exactly a3, have to change this ; for LT Scaling ; (setq pdgscc4 (* pdgscc 4 )) ;ltscale 스케일의4배 ; (setvar "ltscale" pdgscc4) ; 치수스케일 도면축척과 동일 ; set osmode to X, P, S, I, D, C, M, E (setvar "osmode" 4335) ; for scaling, if pppscaleonfit is "fit" no need to use this value (setq PLOTSCALE (STRCAT "1=" (rtos (/ pdgscc1 pdgsccpaper) 2 0))) ; fit = scale to paper, on scale to scale value (if (= pppscaleonfit "fit") (setq PLOTSCALE "fit") (setq PLOTSCALE PLOTSCALE)) (setq fname (getvar "dwgname")) ;get file name (setq fname (substr fname 1 (- (strlen fname) 4))) ;delete ".dwg" (setq sffx (rtos (getvar "cdate") 2 6)) ; make time string for add suffix to file name (setq fname (strcat PATH fname sffx ".pdf")) ;make path+filename+time ; set PLOTTRANSPARENCYOVERRIDE value (command "PLOTTRANSPARENCYOVERRIDE" pltovrd) ; for zoom to what block is now printing ;(command "zoom" P_ppw1 P_ppw2) ; don't use it makes me headaches ; now we printing (command "-PLOT" "Y" "model" P_plotername ; plotter name P_papername ; paper name "M" ; model space wlp ; landscape or portrait "N" "W" ppw2 ppw1 PLOTSCALE "C" "Y" ctbname "Y" ; line weight "A" ; Shaded Plot : all as view (A) / wire frame (W) / hide (H) / view style (V) / render (R) fname ; file name "Y" ; save plot setting "Y" ; execute plot ) (command "delay" ; for artificial spool time for pdf, 10 second is 10000 PDFdelay ) (command "osmode" "4335") (setq n (1+ n)) ); end of repeat ); end of progn ); end of if (command "PLOTTRANSPARENCYOVERRIDE" 1) (princ "\n Printing Complete! Check your dwg's folder") (princ path) (princ) ) ; https://forums.augi.com/showthread.php?137837-Sort-Selectionset-by-X-coord&p=1164232&viewfull=1#post1164232 ; SortSelectionSetByXYZ by peter ; this is edited code for multisort XY, not original code (defun sortListofSublistsbyItemX (lstOfSublists intItem intDirection) (if (> intDirection 0) (vl-sort lstOfSublists '(lambda (X Y) (if (eq (nth intItem X) (nth intItem Y)) (< (nth (- intItem 1) X) (nth (- intItem 1) Y)) (< (vl-prin1-to-string (nth intItem X)) (vl-prin1-to-string (nth intItem Y))) ) ) ) (vl-sort lstOfSublists '(lambda (X Y) (if (eq (nth intItem X) (nth intItem Y)) (> (nth (- intItem 1) X) (nth (- intItem 1) Y)) (> (vl-prin1-to-string (nth intItem X)) (vl-prin1-to-string (nth intItem Y))) ) ) ) ) ) (defun SelectionSetToList (ssSelections / intCount lstReturn) (if (and ssSelections (= (type ssSelections) 'PICKSET) ) (repeat (setq intCount (sslength ssSelections)) (setq intCount (1- intCount) lstReturn (cons (ssname ssSelections intCount) lstReturn) ) ) ) (reverse lstReturn) ) (defun ListToSelectionSet (lstOfEntities / ssReturn) (if lstOfEntities (foreach entItem lstOfEntities (if (= (type entItem) 'ENAME) (if ssReturn (setq ssReturn (ssadd entItem ssReturn)) (setq ssReturn (ssadd entItem)) ) ) ) ) ssReturn ) (defun SortSelectionSetByYXZ (ssSelections / lstOfSelections lstOfSublists lstSelections) (if (and (setq lstSelections (SelectionSetToList ssSelections)) (setq lstOfSublists (mapcar '(lambda (X)(cons X (cdr (assoc 10 (entget X))))) lstSelections)) (setq lstOfSublists (sortlistofsublistsbyitemX lstOfSublists 2 1)) (setq ssSelections (listtoselectionset (mapcar 'car lstOfSublists))) ) ssSelections ) ) I edited it little bit to be simple. - eng translate - set print path to drawing file's - get print setting, you can change this in PLOT command window. push 'apply to layout' (same button we use in publish) - you can adjust PDFdelay variable = delay time 3 seconds (= 3000) to fit your environment. if it makes jam. - pdf sorted by Upper Left to Lower Right