All Activity

I guess you could do like (setq i (+ i 0.01)) 16 vertex poly would then create a 1600 vertex poly And then run overkill on the created polyline to remove all collinear vertexes.

looks like your command outputs like Tot: 1 | x, y, z Tot: 2 | x, y, z Tot: 3 | x, y, z Another option if you just using that output for checking use the status line with modemacro tho it would only be the last count / point info ;;----------------------------------------------------------------------------;; ;; Insert Block with Tot: Count and X, Y, Z output into status bar (defun c:mbi ( / *error* nobi p doc) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (princ "\n Multi-Insert Block w.Total <!pp> ..") (command "DDINSERT" "\\") (setvar 'cmdecho 0) (setq nobi 1) (ccv nobi) (while T ;; insert loop of selected block (command "_.-INSERT" "" "_s" 1 "_r" 0 "\\") ;; "_y") ; (setq nobi (+1 nobi) (ccv nobi) ;passes nobi to ccv as i ) (vla-endundomark doc) (setvar 'MODEMACRO "") (setvar 'cmdecho 1) (princ) ) (defun ccv (i / p str) (setq p (getvar 'lastpoint)) (setq str (strcat "Tot: " (rtos i) " | " (rtos (car p) 2 4) "," (rtos (cadr p) 2 4) "," (rtos (caddr p) 2 4))) (SETVAR 'MODEMACRO str) )

Saw this when searching for something else. can be modified for blocks attributes.

I guess the solution is to programme how you currently do this - what is your manual method? As for a solution, haven't looked how SLW210 does his but might expand MHUPP to use both polylines and find the mid points using all verticies.

You can try this...I am not sure how accurate it will be for you, but 100-500 sample size looked pretty good on your drawing, you can change the default, but I kept it at 50 for myself. ;;; Draw a polyline centered between two selected polylines (can be dissimilar/irregular). ;;; ;;; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/#findComment-676800 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; (defun c:DrawCl (/ pl1 pl2 num-pts len1 n dist step pt1 pt2 midpt pts) (vl-load-com) ;; Select first polyline (setq pl1 (car (entsel "\nSelect first polyline: "))) (if (not (and pl1 (= (cdr (assoc 0 (entget pl1))) "LWPOLYLINE"))) (progn (princ "\nInvalid first selection.") (exit)) ) ;; Select second polyline (setq pl2 (car (entsel "\nSelect second polyline: "))) (if (not (and pl2 (= (cdr (assoc 0 (entget pl2))) "LWPOLYLINE"))) (progn (princ "\nInvalid second selection.") (exit)) ) ;; Set number of sample points to use (it uses last number entered, default is 50) (if (not *CL_lastNumPts*) (setq *CL_lastNumPts* 50)) (setq num-pts (getint (strcat "\nEnter number of sample points <" (itoa *CL_lastNumPts*) ">: ") ) ) (if (null num-pts) (setq num-pts *CL_lastNumPts*)) (setq *CL_lastNumPts* num-pts) ;; Calculate (setq len1 (vlax-curve-getDistAtParam pl1 (vlax-curve-getEndParam pl1))) (setq step (/ len1 num-pts)) (setq dist 0.0 pts '() ) ;; Midpoint list (repeat (1+ num-pts) (setq pt1 (vlax-curve-getPointAtDist pl1 dist)) (setq pt2 (vlax-curve-getClosestPointTo pl2 pt1)) (if (and pt1 pt2) (setq pts (cons (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2) pts)) ) (setq dist (+ dist step)) ) ;; Create polyline (if pts (progn (setq pts (reverse pts)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 70 0) ) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) (princ "\nCenterline drawn accurately between polylines.") ) (princ "\nNo points generated — check polylines.") ) (princ) ) (princ "\nType DrawCl to draw a centerline between two polylines.") (princ) That said, I just tried Lee Mac's cPoly in mhupp's last link posted, seems to be similar results to mine if you adjust the sample points. I haven't checked the others yet, I'll run through them if I get time. I originally made mine with the command function, then changed it to entmake, pretty sure the accuracy is the same, it just had a lot of "Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:" in the commandline for each sample. P.S. Mine should take into account reversed polylines. At the same sample size, mine and Lee Mac's seem to be exactly the same on your drawing. I still have to do on mine, set a layer and linetype option in the code.

Thanks Lee.. you continue to inspire many. (defun c:mbi ( / *error* nobi p) (princ "\n Multi-Insert Block w.Total <!pp> ..") (defun *error* ( msg ) (setvar 'cmdecho 0) ;; 5.28.24 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (if msg (prompt (strcat "\n" msg))) (setvar 'cmdecho 1) (princ) ) (defun ccv ( / p) (setq p (getvar 'lastpoint)) (princ (setq pp ;; make/prints coords & paste usable (strcat " | " (rtos (car p) 2 4) "," ;; 'p' -- vertex from getpoint,... (rtos (cadr p) 2 4) "," (rtos (caddr p) 2 4) ) ) ) ) (command "DDINSERT" "\\") (setvar 'cmdecho 0) (setq nobi 1) (princ (strcat "\n Tot: " (rtos nobi))) (ccv) ;; coords (while T ;; insert loop of selected block (setq nobi (1+ nobi)) (princ (strcat "\n Tot: " (rtos nobi))) (command "_.-INSERT" "" "_s" 1 "_r" 0 "\\") ;; "_y") ; (ccv) ;; coords ) (*error* nil) (princ) )

My version of GStarCAD is 2023 Italian Even my social life is not the most active... but in 30 years of CAD I have reached a good level of basic Lisp... but nothing more complicated GSTARCAD is excellent software ... but sometimes it has small bugs that have never been fixed: (vl-sort '("2" "1" "3" "1") '<) In Autocad: ("1" "1" "2" "3") in GStarCAD: ("1" "2" "3") Duplicate elements are removed!

After a quick look on GstarCAD, DBX works, though some commands may be different from AutoCAD's. If time allows I might make an attempt to narrow down some options.

in essence I took out the dbx stuf like : (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) In lasted version I used : (defun Get_EX_Blocknames (dbDoc / fn l) (if (and (eq (type dbDoc) 'STR)(setq fn (findfile dbDoc)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) instead of using (vla-open dbx dwg) I now used (vla-open (vla-get-documents (vlax-get-acad-object)) fn) using vla-open means you best only use vla- commands and never ever use vla-activate until the very last end because at that point lisp focus will end there and any code left with it. Lisp can only run in one document at the time , but when using vla- commands only it is possible to open and close other drawing and stil maintain lisp focus. Maybe not beginners stuf but me too only got where I am by beg steal & borrow code from others , change things an see what happens. This all costs time but having a wife with her own hobbies or not having a social life all helps

That's not what steven-g used, plus Autodesk shut them down. From Danielm103's link. They suggest BricsCAD now.

What version of GstarCAD are you using? Enhanced API in GstarCAD 2024 I would think anything that runs in AutoCAD LT would work, if I have time and @rlx doesn't get back, I'll try to look at them (I am curious about this). If you could carefully list out what happened with each code in AutoCAD and GstarCAD, it would help.

Out of curiosity, since for me many of the commands you wrote are as understandable as ancient Aramaic: which are the commands that you didn't include in the latest version... and that allowed Lisp to work even on GSTARCAD?

Youre welcome Only tweak I would probably do is to select your basepoint at the same time when you select your objects but that should be easy to do , but its not that importand anyways. For now : paste away ...

I created a pdf with all the steps: as expected by RLX, the lisp works perfectly! 'cbp2.lsp' can be used by those like me who use GStarCAD. Thank you very much! CBP2.pdf

Sounds like your on the right track. Correct, adding a number should not be factored by any position in the dwg. The "stutter" effect would be cool if it's possible (repeats the sequence number for every block with matching attribute values before moving on). Thanks for exploring this1

I used Battman and changed the attribute order that way my default sort and count worked. using Battman can move attribute order not actual position in block. Ok part 2 is to add a number to each block where attributes are the same that is a new step in my program, but have something. getting way more complicated. The auto number would be based on the "1st sort order attribute" so a 1000=1, 1100=2 and so on not based on position in dwg is that ok ?

Hello. I’m fairly new to Revit so I’m probably going to butcher this question. Is it possible to place different devices throughout a floor plan, based solely on the Room Tag. For instance, if there was a schedule that contained all of the different room names, could I go through that line by line and for a classroom, insert device A, for a kitchen, insert device B. Then when I opened up the floor plan, all of those devices would be there and I would just have to fine tune their location. Hopefully that made sense.

Yeah, that was LT-Extender https://www.lt-extender.com/LT-Extender/englisch/default.htm I can’t see how companies could buy a cad package that does not have a robust API. There’s a lot of competition in this space these days.

"Was an AutoCAD LT expert" there was lisp enabler and pretty sure Autodesk legal team shut them down. It was produced way back around 2005. It was called LT-Extender. Google can find some info about it.

Did you try changing 57.40259411 not sure bigger or smaller needed, not tested.

Yes I have draw a grid on a viewport, rotation is supported, may cost you a cup of coffee.

You can try if this works better. No dbx in this version Start app , make selection , select drawing you want to paste in later. This drawing is shortly opened (not sure if it works if drawing is already open) List with blocknames is created and drawing is closed. Blocknames are compared and if duplicates are found message is displayed. You can choose 1- Stop , 2 - Rename the blocks in drawing you made the selection set (not the other drawing), or 3 - copy / paste as it is. Only thing left to do is select your basepoint (or replace 'pause' with "0,0" in the code) and selection set is placed on clipboard , ready to paste. ;;; check before paste - rlx 2025-10-22 (defun c:cbp ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames dbx-doc) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Drawing to check before you paste" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-other-dwg (Get_EX_Blocknames other-dwg))) (setq blocknames-in-other-dwg (mapcar 'strcase blocknames-in-other-dwg))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (setq inp (cfl (list "1 - I'm not gonna paste" "2 - Rename blocks before pasting" "3 - I'm gonna paste anyway"))) (cond ((or (void inp) (wcmatch inp "1*")) (alert "Copybase aborted")) ((wcmatch inp "2*")(foreach b duplicate-blocknames (rename_block_definition b)) (princ "\nBlocks are renamed - select your basepoint now") (command "_copybase" pause ss "")) ((wcmatch inp "3*") (princ "\nBlock names unchanged - select your basepoint now")(command "_copybase" pause ss "")) (t (princ"\nBite me...")) ) ) (progn (princ "\nNo duplicate block names found - select your basepoint")(command "_copybase" pause ss "")) ) ) ) (princ) ) ;;; get block names active doc - vanilla (defun _bl ( / b l ) (while (setq b (tblnext "BLOCK" (null b))) (if (zerop (boole 1 21 (cdr (assoc 70 b)))) (setq l (cons (cdr (assoc 2 b)) l)))) l) (defun Get_EX_Blocknames (other-dwg / fn l) (if (and (eq (type other-dwg) 'STR)(setq fn (findfile other-dwg)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bc bn ) (setq bc (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn bc)(setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss)(if (and (setq n (block-n o))(not (member n l)))(setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun void (x) (or (eq x nil)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x))(eq "" (vl-string-trim " \t\r\n" x))))) (defun block-n (o)(if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil)) (defun Collection-Member (m c / r) (if (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vla-item (list c m)))) nil r)) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) edit : just had an idea , why not open the 'to be pasted' drawing after you made your selection. Also tried if it was a bad thing if both drawings were already open and yes , that's bad... but then I'm a bad bad dragon (it still opens but as read only) Because I use vla-activate at the end , all lisp stops (obviously) Once drawings is activated you can copypaste / ctrl-V yourself (I'm sure as hell not comming to do that for you ) You decide what make you happy... ;;; check before paste 2 : after selection open the 'to be pasted' drawing - rlx 2025-10-22 (defun c:cbp2 ( / acDoc *docs* ss dbDoc blocknames-in-selectionset blocknames-in-dbDoc duplicate-blocknames inp do-it) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)) *docs* (vla-get-documents (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq dbDoc (getfiled "Drawing to check before you paste" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-dbDoc (Get_EX_Blocknames dbDoc))) (setq blocknames-in-dbDoc (mapcar 'strcase blocknames-in-dbDoc))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-dbDoc)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (setq inp (cfl (list "1 - I'm not gonna paste" "2 - Rename blocks before pasting" "3 - I'm gonna paste anyway"))) (cond ((or (void inp) (wcmatch inp "1*")) (alert "Copybase aborted")) ((wcmatch inp "2*")(foreach b duplicate-blocknames (rename_block_definition b)) (princ "\nBlocks are renamed - select your basepoint now") ;|(command "_copybase" pause ss "")|; (setq do-it t)) ((wcmatch inp "3*") (princ "\nBlock names unchanged - select your basepoint now") ;|(command "_copybase" pause ss "")|; (setq do-it t)) (t (princ"\nBite me...")) ) ) (progn (princ "\nNo duplicate block names found - select your basepoint") ;|(command "_copybase" pause ss "")|; (setq do-it t)) ) ) ) (if do-it (do_it)) ) (defun do_it ( / f d) (command "_copybase" pause ss "")(and (eq (type dbDoc) 'STR) (setq f (findfile dbDoc))(setq d (vla-open *docs* f)))(vla-activate d)) ;;; get block names active doc - vanilla (defun _bl ( / b l ) (while (setq b (tblnext "BLOCK" (null b))) (if (zerop (boole 1 21 (cdr (assoc 70 b)))) (setq l (cons (cdr (assoc 2 b)) l)))) l) (defun Get_EX_Blocknames (dbDoc / fn l) (if (and (eq (type dbDoc) 'STR)(setq fn (findfile dbDoc)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bc bn ) (setq bc (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn bc)(setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss)(if (and (setq n (block-n o))(not (member n l)))(setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun void (x) (or (eq x nil)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x))(eq "" (vl-string-trim " \t\r\n" x))))) (defun block-n (o)(if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil)) (defun Collection-Member (m c / r) (if (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vla-item (list c m)))) nil r)) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil)))

See what this does. https://www.cadtutor.net/forum/topic/14213-lisp-to-create-polyline-between-polylines/#findComment-117973

Thanks, @lrm It seems your method relies on there being pairs of points close together between both polylines. But when several points accumulate on one of them and don't find a corresponding point on the other, the calculated axis deviates from the center, and the method loses consistency. To keep these cases under control, I think it is best to manage them using a Lisp. But maybe I'm wrong

... in fact, ALL (CFD CFLD CAPFD) give me an error: I don't know what I did the first time I used the first file, it even worked on GStarCAD. If I remember correctly, I ran the command with the selection in progress... who knows (!) apparently I bypassed something... but now I can't replicate those steps.