Leaderboard

I did this, but tested superficially. I hope it does what you want! Cut_Poly3D.lsp

I'll assume from your question that it is all loaded (if not this is good resource: https://lee-mac.com/runlisp.html), To run a loaded LISP generally all you need to do is type function name so long as it starts with a c:, (ignore the c:) the function names come after "defun". In the examples above I think the program is (defun c:populate.... and you'll want to type in populate If the function name doesn't have 'c:' then to get that part to run generally put the function name in brackets ( -functionaname- ) Hope this help else you might need to list what you are doing, probably missed a very silly thing - easy to do

Been adding a security check to code for years since "Protect" existed like 30 years ago, like others can use "_PKSER" returns Cad serial number, also yes I know it does work stopped an install by some one not wanting to pay. For us oldies using a DOS command ie CMD in windows you can copy a security lisp to every lisp program that you want then run another lisp that makes all of them into FAS, just done for like 30 lisps for a client. Protecting his investment not mine. The DOS command is as next you need a bat file to do it for all the files COPY D:\mylisps\securty.lsp+D:\mylisps\mylisp1.lsp D:\newfolder\mylisp1.lsp repeat for all lisps Compile 2 examples (defun comp ( ) (if (null vlisp-compile) (c:vlide T)) (setq fname (getfiled "Pick lisp to be compiled" "D:\\alan\\lisp" "lsp" 8)) (setq len (strlen fname)) (setq diff (- len (+ 15 3))) (setq fnameout (substr fname 15 diff)) (vlisp-compile 'st fname (strcat "d:\\alan\\compiled\\" fnameout ".fas")) ) (comp) ; part 2 ; must have vlide open to work (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "Vlide ") (setq loads (list ; make a list of all lsp files. "mylisp1" "mylisp2" )) (setq loc1 "C:\\CAD-TOOLS") ;;change dirs to where ever you want them found (setq loc2 "C:\\CAD-TOOLS\\") ;;change dirs to where ever you want them saved (foreach lisp loads (vlisp-compile 'st (strcat loc1 lisp ".lsp") (strcat loc2 lisp ".fas")) ) For BRICSCAD users just change to BLADE and DES. So as mentioned some security checks Hard disk id Cad serial number Set & Getenv registry check Network card IP address Ping remote server and check in a file User name

"Joining circles via creation order", using ssget can most times do this, try it, but as was posted somewhere else doing a sort on the "Handle ID" of the objects is creation order. I seem to remember must change to a number not hex. Quick and dirty (defun wow ( / ss x) (setq ss (ssget '((0 . "CIRCLE")))) (command "pline") (repeat (setq x (sslength ss)) (command (cdr (assoc 10 (entget (ssname ss (setq x (1- x))))))) ) (command "") ) (wow)

Thank you so much you are still helping people in 2024.

Something like this? ;; For polylines ONLY. Points returned in WCS (defun foo (ent / d dis i m pm p) (setq i 0 p 0.0 m (vlax-curve-getdistatparam ent 1)) (while (setq i (1+ i) d (vlax-curve-getdistatparam ent i)) (and (<= (setq dis (- d p)) m) (setq m dis pm (1- i))) (setq p d) ) (list (vlax-curve-getpointatparam ent pm) ; Start Vertex (vlax-curve-getpointatparam ent (1+ pm)) ; End Vertex (vlax-curve-getpointatparam ent (setq pm (+ 0.5 pm))) ; Mid Vertex (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent pm)) ; Angle at mid vertex ) )

I just tried something, I think it works pretty well. What the script did: it picks a point within a rectangle/box. If that point is not inside the polyline (which can have a weird shape) that point is skipped. and the while-loop tries again. Eventually a point will be found. I added a "not_too_close" condition to the if (in the while). The difference is: there is no guarantee that it's possible to find points that are not too close, you could get into an infinite loop. So maximum 3000 rejected points; after that any point will be marked as okay. You can adapt that 3000 to whatever integer you wish. ;; example: block_name "b", 20 points, 1.5 max_scale, 0.01 min_scale, minimum distance = 1000.0 (defun c:scatter ( / ) (while (populate "b" 20 1.5 0.01 1000.0) ;; ) ) You can adapt at line 76, inside function populate: (setq max_tries 3000) --- (defun rnd (/ modulus multiplier increment rand) (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) rand (/ seed modulus) ) ) (defun GroupByNum ( lst n / r) (if lst (cons (reverse (repeat n (setq r (cons (car lst) r) lst (cdr lst)) r)) (GroupByNum lst n) ) ) ) (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result ) (setq vec12 (mapcar '- pt2 pt1)) (setq vec12 (reverse (cdr (reverse vec12)))) (setq vec1p (mapcar '- pt pt1)) (setq vec1p (reverse (cdr (reverse vec1p)))) (setq vec2p (mapcar '- pt2 pt)) (setq vec2p (reverse (cdr (reverse vec2p)))) (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p)) (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil)) result ) (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result ) (vl-load-com) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq ptt (vlax-curve-getclosestpointto ent pt)) (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt))) (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3)) (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b))))) (setq k 0) (while (< (setq k (1+ k)) (length int)) (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst))) ) (setq tst (reverse tst)) (setq k 0) (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst) (vla-delete xlin) (if kk (if (eq (rem kk 2) 1) (setq result T) (setq result nil)) (setq result nil) ) result ) (setq max_tries 3000) (defun not_too_close (pt allpoints min_dist / okay i) (setq okay T) (setq i 0) (if (> max_tries 0) (repeat (length allpoints) (if (< (distance pt (nth i allpoints) ) min_dist ) (setq okay nil) ) (setq max_tries (- max_tries 1)) (setq i (+ i 1)) ) ) okay ) (defun populate ( bname no scf scfmin min_dist / DX DXX DY DYY ENT ENTA MAXPOINT MAXPT MINPOINT MINPT MSP PT SCFF result) (vl-load-com) (setq result nil) (setq allpoints (list)) (setq max_tries 3000) ;; 3000 attemps to reject a block that is too close to other blocks (setq ent (car (entsel "\nPick 2D closed entity"))) (while (eq (cdr (assoc 70 (entget ent))) 0) (prompt "\nPicked entity is open, please pick closed one") (setq ent (car (entsel "\nPick 2D closed entity"))) ) (setq entA (vlax-ename->vla-object ent)) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (vla-getboundingbox entA 'minpoint 'maxpoint) (setq minpt (vlax-safearray->list minpoint) maxpt (vlax-safearray->list maxpoint) ) (setq dx (- (car maxpt) (car minpt))) (setq dy (- (cadr maxpt) (cadr minpt))) (if (null scfmin) (setq scfmin 1.0)) (while (> no 0) (setq dxx (* dx (rnd))) (setq dyy (* dy (rnd))) (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0)) (if (and (eq scfmin 1.0) (eq scf 1.0)) (setq scff 1.0) (setq scff (+ scfmin (* (- scf scfmin) (rnd))))) (if (and (not_too_close pt allpoints min_dist) (ptinsideent pt ent)) (progn (setq no (1- no)) (setq result (vla-insertblock msp (vlax-3d-point pt) bname scff scff scff (* 2 pi (rnd)))) (setq allpoints (append allpoints (list pt))) ) ) ) result ) (defun c:populate ( / bname no min_dist) (setq bname "") (while (not (tblsearch "BLOCK" bname)) (setq bname (getstring T "\nInput name of block to populate (CASE UNSENSITIVE) : ")) ) (initget 6) (setq no (getint "\nInput number of blocks to populate : ")) (initget 6) (setq scf (getreal "\nInput max. scale factor for block insertion <1.0> : ")) (if (null scf) (setq scf 1.0)) (initget 6) (setq scfmin (getreal "\nInput min. scale factor for block insertion <1.0> : ")) (setq min_dist (getreal "\nMinimum distance: ") ) (while (populate bname no scf scfmin min_dist) ) (princ) ) (defun c:scatter ( / ) (while (populate "b" 20 1.5 0.01 1000.0) ) )