Leaderboard

just quick written for testing, so no [<-- backspace] function (defun foo ($ n / l k str x) ;;hp:pword 16.04.2020 (terpri) (princ (setq x t str "Password : ")) (while (and x (setq k (grread nil))) (if (and (= (car k) 2) (numberp (setq x (cadr k ))) (< 33 x 127) (< (length l) n) ) (progn (princ (strcat "\r" (setq str (strcat str $)))) (setq l (cons x l)) ) (setq x nil) ) ) (vl-list->string (reverse l)) ) test (defun c:test (/ pw) (if (= "Tharwat" (setq pw (foo "*" 7))) (alert pw) (alert "Sorry!! ask Donald Trump!!") ) (princ) )

@hanhphuc nicely done. Here is my attempt in this regard. (defun c:pass (/ wrd fed str fst snd lst msg gr run) ;; Tharwat - 16.Apr.2020 ;; (setq wrd "AutoLISP" fed "" msg "\rEnter your password : " ) (while (and (not run) (princ (strcat msg fed)) (or (eq (car (setq gr (grread nil))) 5) (member (setq fst (car gr)) '(2 3 25)) ) (numberp (setq snd (cadr gr))) (< 33 snd 127) ) (cond ((and (eq fst 2) (not (member snd '(13 32)))) (setq str (chr snd) fed (strcat fed "*") lst (cons str lst) ) ) ((or (member fst '(3 25)) (member snd '(13 32)) ) (setq run t) ) ) ) (alert (if (= (apply 'strcat (reverse lst)) wrd) "Well done." "Bad input.Try again." ) ) (princ) )

Then you need to use GRREAD function instead.

(getstring...) not (getstrig..)

The following should present a far more reliable method across multiple systems: (defun LM:findfontfile ( fnt / dir ) (if (setq dir (LM:specialfolder "fonts")) (progn (eval (list 'defun 'LM:findfontfile '( fnt ) (list 'findfile (list 'strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir) ) "\\" 'fnt ) ) ) ) (LM:findfontfile fnt) ) ) ) ;; Special Folder - Lee Mac ;; Queries the WshSpecialFolders collection for the specified folder ;; Ref: http://msdn.microsoft.com/en-us/library/9x9e7edx%28v=vs.85%29.aspx (defun LM:specialfolder ( fld / rtn spf wsh ) (if (setq wsh (vlax-get-or-create-object "wscript.shell")) (progn (setq rtn (vl-catch-all-apply '(lambda ( ) (setq spf (vlax-get-property wsh 'specialfolders)) (vlax-invoke-method spf 'item fld) ) ) ) (if spf (vlax-release-object spf)) (vlax-release-object wsh) (if (not (vl-catch-all-error-p rtn)) rtn) ) ) ) (vl-load-com) (princ) _$ (LM:findfontfile "arial.ttf") "C:\\Windows\\Fonts\\arial.ttf"

I've uploaded 2 my programs to download section of cadtutor... I hope you'll find them useful... Here are links : Regards, Marko Ribar, d.i.a. (architect)

Let that be a lesson for you then... That's why it's best to include error-handling functions in the beginning of the code: (defun *error* (msg) (princ (strcat "\nError: " msg))) When a function fails from an error, the *error* function is executed. You can of course define your own *error* function to execute what to do if the function fails. Next lesson, set all your variables local to the function. That way it won't mess up other functions containing the same variables. You know how, right? (defun c:functionname ( / *error* list_wcm l_o_s_1_length ...) ; <--- Set local to the function (defun *error* (msg) (princ (strcat "\nError: " msg))) ;; Rest of code ) It's crucial that you set the *error* local to the function, because if you don't, then other functions that doesn't have the *error* function will call that very same function on fail. As an added function, run the (*push-error-using-command*) command and proceed. Not that I know much about error-handling, so I'm in no position to be teaching you.

For example: (defun rgb->hex ( r g b ) (apply 'strcat (mapcar '(lambda ( x ) (setq x (strcat "00" x)) (substr x (1- (strlen x)))) (mapcar 'LM:dec->hex (list r g b)) ) ) ) ;; Decimal to Hexadecimal - Lee Mac ;; Converts a decimal number to hexadecimal string ;; d - [int] 32-bit signed integer ;; Returns: [str] Hexadecimal representation of supplied integer (defun LM:dec->hex ( d ) (if (< d 16) (chr (+ d (if (< d 10) 48 55))) (strcat (LM:dec->hex (/ d 16)) (LM:dec->hex (rem d 16))) ) ) _$ (rgb->hex 255 0 0) "FF0000"

That's actually an interesting one, and I'm quite surprised that there's no solution in Google anywhere for AutoLISP. Let me be the first then: ;; JH:RGB->HEX --> Jonathan Handojo ;; Converts an RGB to HEX in the form of a string (defun JH:RGB->HEX (r g b) (apply 'strcat (mapcar '(lambda (x / h) (if (< (strlen (setq h (JH:numhex x))) 2) (strcat "0" h) h)) (list r g b))) ) ;; JH:numhex --> Jonathan Handojo ;; Converts an integer to a hex number in the form of a string (defun JH:numhex (num / hex) (setq hex (mapcar 'cons '(10 11 12 13 14 15) (mapcar 'chr '(65 66 67 68 69 70)))) (apply 'strcat ((lambda (x / l h) (if (zerop x) '("0") (progn (while (/= x 0) (setq l (cons (cond ((cdr (assoc (setq h (rem x 16)) hex))) ((itoa h))) l) x (/ x 16) ) ) l ) ) ) num ) ) ) I'm sure someone has a better approach. _$ (JH:RGB->HEX 45 89 142) "2D598E"

Turn your wcmatch around

I wrote this simple backplot lisp to check gcode files I am writing via lisp routines. It is very basic and set up for 3 axis Fanuc mill type Gcode. It is currently only set up for xy plane arcs and G00, G01, G02, G03 feed moves. Other GCodes are filtered out and ignored. It would not be difficult to modify it for use with 3d printer type gcodes if you wanted to. Its not the cleanest code, and there are probably some mistakes in it, but so far it has been pretty reliable. Feel free to use or modify it. BackPlot.lsp

Foreach is not the solution to everything. There are other ways to do it. For example: Include this in the start of the code: (setq pairs '( ("lp" . block_name1) ("bet" . block_name2) ("kk" . block_name3) ) ) And rather than replacing the original foreach in the forum with my previous code, replace the foreach with this instead: (vl-some '(lambda (x) (if (wcmatch (cdr (assoc 1 entget_data_from_selection_1)) (strcat "*" (car x) "*")) (entmake (list '(0 . "INSERT") (cons 2 (cdr x)) '(8 . "PUU") (cons 10 (cdr (assoc 11 entget_data_from_selection_1))) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0) '(50 . 0.0))) ) ) pairs ) vl-some processes every element in the list with a function accepting one argument representing each element in the list (like x in foreach) (in the above case, it's "lambda"), and returns what the function will return resulting from the first element in the list that evaluates to anything other than nil to the function. Once that happens, vl-some will stop processing the remainder of the list.

(wcmatch (cdr (assoc 1 entget_data_from_selection_1)) "*lp*,*kk*,bet*")

Replace the last line of your code (your foreach loop) with: (if (wcmatch (cdr (assoc 1 entget_data_from_selection_1)) "*lp*") (entmake (list '(0 . "INSERT") '(2 . <block_name_in_string>) '(8 . "PUU") (cons 10 (cdr (assoc 11 entget_data_from_selection_1))) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0) '(50 . 0.0))) ) When drawing a block, you need to define the block name (2), scale (X,Y,Z : 41,42,43), and rotation (50) of the block... just like how you need the text height and text content for text. If you don't give it a block name, how can AutoCAD possibly insert the block?

Perhaps something like this? ;; Get Password - Lee Mac ;; Prompts the user to enter a string whilst disguising the input ;; msg - [str] [Optional] Prompt string ;; Returns: [str] Input received from the user, else an empty string (defun LM:getpassword ( msg / gr1 gr2 rtn ) (setq msg (princ (cond (msg) ("\nEnter password: "))) rtn "" ) (while (progn (setq gr1 (grread nil 10) gr2 (cadr gr1) gr1 (car gr1) ) (cond ( (= 2 gr1) (cond ( (< 31 gr2 127) (setq rtn (strcat rtn (chr gr2))) (princ "\225") ) ( (= 13 gr2) nil ) ( (and (= 8 gr2) (< 0 (strlen rtn))) (setq rtn (substr rtn 1 (1- (strlen rtn)))) (princ "\010 \010") ) ( t ) ) ) ( (= 25 gr1) nil ) ( t ) ) ) ) rtn ) (LM:getpassword nil)

For AutoLISP I use the VLIDE, for C#/VB .NET I use Visual Studio, for everything else I use Notepad++.

https://www.afralisp.net/archive/lispa/lisp48h.htm

I write about 95% of my code using notepad and notepad++ rarely use vlide only when I can not work out what is going on. I tend to write, copy and paste to command line and test as I go rather than write 100 lines and test. I can see every one jumping up and down that's not the way to do it. I put break points into my code (alert "got to here") Lee-mac and others how do you do it ?

A better way if you just want a certain number of commands to always be displayed then why not make a custom toolbar ! I took CIV3D pulled choices out of 3 menus and made 1 new that I run in my Drafting workspace saving having to change workspaces. I am happy to start you off its simple to do just start CUI and notepad you copy the details from the cui into notepad making your menu. I know you can do it all in the cui but I find it easier having a custom mnu that's easy to edit. This is a custom toolbar that I made, you can see the commands in it. You just use menuload to add it. ***MENUGROUP=ALANSTOOLBAR ***TOOLBARS **ALANSTOOLS ID_ALAN_0 [_Toolbar("Alans1", _Right, _Show, 0, 0, 1)] AECC_ShowTS [_Button("Show Toolspace", RCDATA_16_IMAGE, RCDATA_16_IMAGE)]^C^C^C^P_ShowTS ID_Matchprop [_Button("Match Properties", RCDATA_16_MATCH, RCDATA_16_MATCH)]^C^C_matchprop ID_Erase [_Button("Erase", RCDATA_16_ERASE, RCDATA_32_ERASE)]^C^C_erase ID_Copy [_Button("Copy", RCDATA_16_COPYOB, RCDATA_32_COPYOB)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_copy,^C^C_copy) ID_Mirror [_Button("Mirror", RCDATA_16_MIRROR, RCDATA_32_MIRROR)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_mirror,^C^C_mirror) ID_Offset [_Button("Offset", RCDATA_16_OFFSET, RCDATA_32_OFFSET)]^C^C_offset ID_Array [_Button("Array...", RCDATA_16_ARRREC, RCDATA_32_ARRREC)]^C^C_array ID_Move [_Button("Move", RCDATA_16_MOVE, RCDATA_32_MOVE)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_move,^C^C_move) ID_Rotate [_Button("Rotate", RCDATA_16_ROTATE, RCDATA_32_ROTATE)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_rotate,^C^C_rotate) ID_Scale [_Button("Scale", RCDATA_16_SCALE, RCDATA_32_SCALE)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_scale,^C^C_scale) ID_Stretch [_Button("Stretch", RCDATA_16_STRETC, RCDATA_32_STRETC)]$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,4),GRIP),_stretch,^C^C_stretch) ID_Trim [_Button("Trim", RCDATA_16_TRIM, RCDATA_32_TRIM)]^C^C_trim ID_Extend [_Button("Extend", RCDATA_16_EXTEND, RCDATA_32_EXTEND)]^C^C_extend ID_BreakSele [_Button("Break at Point", RCDATA_16_BREAKATPT, RCDATA_32_BREAKATPT)]^C^C_break \_f \@ ID_Break [_Button("Break", RCDATA_16_BRE2PT, RCDATA_32_BRE2PT)]^C^C_break ID_Join [_Button("Join", RCDATA_16_JOIN, RCDATA_32_JOIN)]^C^C_join ID_Chamfer [_Button("Chamfer", RCDATA_16_CHAMFE, RCDATA_32_CHAMFE)]^C^C_chamfer ID_Fillet [_Button("Fillet", RCDATA_16_FILLET, RCDATA_32_FILLET)]^C^C_fillet ID_Explode [_Button("Explode", RCDATA_16_EXPLODE, RCDATA_32_EXPLODE)]^C^C_explode ID_LAYFRZ [_Button("Layer, Layer Freeze", RCDATA_16_FRZLAY, RCDATA_32_FRZLAY)]^C^C_layfrz ID_LAYOFF [_Button("Layer Off", RCDATA_16_OFFLAY, RCDATA_32_OFFLAY)]^C^C_layoff ID_LAYISO [_Button("Layer Isolate", RCDATA_16_LAYISO,RCDATA_32_LAYISO)]^C^C_layiso MM_LAYUNISO [_Button("Layer Unisolate", RCDATA_16_LAYUNISO, RCDATA_32_LAYUNISO)]^C^C_Layuniso ID_LAYDEL [_Button("Layer, Layer Delete", RCDATA_16_LAYER_DELETE,RCDATA_32_LAYER_DELETE)]^C^C_laydel ID_Line [_Button("Line", RCDATA_16_LINE,RCDATA_32_LINE)]^C^C_line MM_1608 [_Button("Circle", RCDATA_16_CIRRAD,RCDATA_32_CIRRAD)]^C^C_circle MM_1607 [_Button("Arc", RCDATA_16_ARC3PT,RCDATA_32_ARC3PT)]^C^C_arc ID_Pline [_Button("Polyline", RCDATA_16_PLINE,RCDATA_32_PLINE)]^C^C_pline ID_Pedit [_Button("Polyline Edit", RCDATA_16_PEDIT, RCDATA_32_PEDIT)]^C^C_pedit ID_DrawordeB [_Button("Draw Order, Send to Back", RCDATA_16_SN2BCK,RCDATA_32_SN2BCK)]^C^C^P_ai_draworder _Back ^P ID_Appload [_Button("Load Application...", RCDATA_16_LOAD_APPLICATIONS,RCDATA_16_LOAD_APPLICATIONS)]^C^C_appload

I don't understand how that code can work PATH /= "PATH". Graphic to help you understand:

@hanhphuc thanks for the call-out, not sure if I can help this looks to me to be purely a macro to run a Lisp routine and I'm Lispless (LT). But having said that I see that the OP tried starting the 'line' command using a stored string in the users1 variable, again something that is not available in LT (only userr1-5 and useri1-5), however this Diesel sequence does work to start the line command using a string stored in an environmental variable (test) which may or may not help. PS don't try this in full AutoCAD because I don't think full AutoCAD has access to the "GETENV" command outside of Lisp ^C^C^C$M=$(eval,$(getenv,test)) So I would imagine that this should also work in full AutoCAD using ^C^C^C$M=$(eval,$(getvar,users1)) Unfortunately I can't test it.

Johnathon ahs provided an answer but why not just draw the last circle or is there something your not telling us ? (while (setq pt (getpoint "\nSpecify center Enter to exit: "))

(defun c:example ( / pt rad) (setq rad 1) ; <--- Circle radius (while (setq pt (getpoint "\nSpecify center: ")) (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 rad))) ) (entmake (list '(0 . "CIRCLE") (cons 10 (progn (initget 1) (getpoint "\nSpecify center for last circle: "))) (cons 40 rad) ) ) (princ) )

I would have thought the room size is wrong it should be calculated without the door arc This is a big amount if talking flooring material I have not seen carpet missing at the doorway. Looking at the drawing need a line drawn across the doorway on a no plot layer, then turn the layer doors off.

another offset concept 2 options ;; Offset segment for polyline (defun c:OFFSEG ( / *error* $ aa aa* _angle ang ax en ep force_closed i ip k l l1 lst n p p1 px s sc sp vs ) ;;hanhphuc 01.04.2020 ;*offseg_area* - global variable (setq force_closed 1 ;; setting closed=1 , open=0 *error* '((msg) (princ " *cancel*")) _angle '((en x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x))) ) (while (setq s (ssget "_:S:E:L+." '((0 . "LWPOLYLINE")))) (and (setq en (ssname s 0) p1 (osnap (cadr (grread t 13)) "_nea")) (not (vla-put-closed (vlax-ename->vla-object en) force_closed )) (setq p (trans p1 1 0) i (fix (vlax-curve-getparamatpoint en p)) ep (vlax-curve-getEndParam en)) (>= ep 2) (setq ang (mapcar '(lambda (x) (_angle en x) ) (cond ( (< i 1)(list (1- ep) (1+ i)) ) ( (>= i (1- ep)) (list (1- i) 0)) ( (list (1- i) (1+ i)) ) ) ) ) (setq *offseg_area* (ureal 5 "" "\nEnter area " (cond ( *offseg_area* ) ( 0.000 ) ) ) ) (princ "\nStretching segment.. \n") (while (and p (mapcar 'set '(k p) (grread t 13)) (= 5 k) (vl-consp p) (setq p1 (trans p 1 0)) ) (redraw) (if (vl-some 'not (setq l (mapcar '(lambda (a b / p) (list (setq p (vlax-curve-getPointAtParam en b)) (inters p (polar p a 1.0) p1 (polar p1 (_angle en i) 1.0 ) nil ) ) ) ang (list i (1+ i)) ) l1 (apply 'append l) n (length l1) lst (mapcar '(lambda (x) (nth x l1)) '(0 1 3 2)) ) ) (setq p nil) (if (= *offseg_area* 0.0) (progn (grvecs (apply 'append (mapcar '(lambda (x) (cons (car x) (mapcar '(lambda (x) (trans x 0 1) ) (cdr x) ) ) ) (cons (cons 2 (mapcar 'cadr l)) (mapcar '(lambda (x) (cons 2 x)) l ) ) ) ) ) (princ (apply 'strcat (setq $ (list "\rArea = " (rtos (setq AA* (abs (math:area lst))) 2 2 ) " M\U+00B2 " ) ) ) ) ) (princ (strcat "\rSelect offset side.. ")) ) ) ); while (if (and (/= *offseg_area* 0.00) (setq ip (apply 'inters (apply 'append (reverse (cons '(nil) l))) ) ) (setq AA (abs (math:area (list (car l1) ip (caddr l1))) ) ) (setq Ax ((if (minusp (- AA (abs (math:area (list (cadr l1) ip (cadddr l1)))) ) ) + - ) AA *offseg_area* ) sc (sqrt (/ (abs Ax) AA)) lst (cons (car l1) (append (mapcar '(lambda (x) (polar ip (angle ip (x l1)) (* (distance ip (x l1)) sc ) ) ) (list car caddr) ) (list (caddr l1)) ) ) AA* (abs (math:area lst)) $ (list "\rArea = " (rtos AA* 2 2) " M\U+00B2 " ) ) (equal AA* *offseg_area* 1e-6) ) ;and (princ (apply 'strcat $ ) ) (progn (setq sp (mapcar '(lambda (x) (vlax-curve-getPointAtParam en x) ) (list i (1+ i)) ) px (mapcar '(lambda (` p a) (polar p a (` (/ *offseg_area* (abs (* (sin (- (cadr ang) (_angle en i))) (apply 'distance sp) ) ) ) ) ) ) (if (LM:Inside-p p en ) ;;; UCS some not working (list - +) (list + -)) sp ang ) ) (setq lst (if (= *offseg_area* 0.0) lst (list (car sp) (car px) (cadr px) (cadr sp) ) ) AA* (abs (math:area lst)) $ (list "\rArea = " (rtos AA* 2 2) " M\U+00B2 " ) ) ) ) ;if (if (or (equal AA* *offseg_area* 1e-6) (= *offseg_area* 0.0) ) (entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(70 . 0) (cons 90 (length lst)) (mapcar '(lambda (x) (cons 10 x)) lst) ) ) (if (not (= *offseg_area* 0)) (alert (strcat "Exceed chamfer limit!\nMax = " (if ip (rtos AA 2 2) "???") "\ M\U+00B2" ) ) ) ) ) ) (princ) ) ;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 ;published by New Riders Publications. ;This credit must accompany all copies of this function. ;;;October 19, 2004 added function chkkwds (see description at end of file) ;* UREAL User interface real function ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. ;* MSG is the prompt string, to which a default real is added as <DEF> (nil ;* for none), and a : is added. ;* (defun ureal (bit kwd msg def / inp) (if def (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2) (if (eq (type def) 'INT) (itoa def) def ) ) ">: " ) bit (* 2 (fix (/ bit 2))) ) (setq msg (strcat "\n" msg ": ")) ) (initget bit kwd) (setq inp (getreal msg)) (if inp inp def ) ) ;;----------------------=={ Inside-p }==----------------------;; ;; ;; ;; Predicate function to determine whether a point lies ;; ;; inside a supplied LWPolyline. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac - www.lee-mac.com ;; ;; Using some code by gile (as marked below), thanks gile. ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; pt - 3D WCS point to test ;; ;; ent - LWPolyline Entity against which to test point ;; ;;------------------------------------------------------------;; ;; Returns: T if supplied point lies inside supplied LWPoly ;; ;;------------------------------------------------------------;; (defun LM:Inside-p ( pt ent / _GroupByNum lst nrm obj tmp ) (defun _GroupByNum ( l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n) ) ) ) (if (= (type ent) 'VLA-OBJECT) (setq obj ent ent (vlax-vla-object->ename ent)) (setq obj (vlax-ename->vla-object ent)) ) (setq lst (_GroupByNum (vlax-invoke (setq tmp (vlax-ename->vla-object (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (trans '(1. 0. 0.) ent 0)) ) ) ) ) 'IntersectWith obj acextendnone ) 3 ) ) (vla-delete tmp) (setq nrm (cdr (assoc 210 (entget ent)))) ;; gile: (and lst (not (vlax-curve-getparamatpoint ent pt)) (= 1 (rem (length (vl-remove-if (function (lambda ( p / pa p- p+ p0 s1 s2 ) (setq pa (vlax-curve-getparamatpoint ent p)) (or (and (equal (fix (+ pa (if (minusp pa) -0.5 0.5))) pa 1e-7) (setq p- (cond ( (setq p- (vlax-curve-getPointatParam ent (- pa 1e-7))) (trans p- 0 nrm) ) ( (trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-7)) 0 nrm) ) ) ) (setq p+ (cond ( (setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-7))) (trans p+ 0 nrm) ) ( (trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-7)) 0 nrm) ) ) ) (setq p0 (trans pt 0 nrm)) (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod ) (and (/= 0. (vla-getBulge obj (fix pa))) (equal '(0. 0.) (cdr (trans (vlax-curve-getFirstDeriv ent pa) 0 nrm)) 1e-9) ) ) ) ) lst ) ) 2 ) ) ) ) ;math formula ; | x1 x2 x3 x4 xn.. | ; 1 | \/ \/ \/ \/ | ;Area= / | /\ /\ /\ /\ | ; 2 | y1 y2 y3 y4 yn.. | ; (defun math:area (l) ;hanhphuc (* (apply '- (mapcar '(lambda (x y) (apply '+ (mapcar '* (mapcar x l) (mapcar y (append (cdr l) (list (car l))))) ) ) '(car cadr) '(cadr car) ) ) 0.5 ) ) 1. if user input any value <> 0 the routine emulates just like OFFSET command does, just move the mouse which side to offset saving typing -ve 2. if user input zero, i.e= 0, activate dynamic mode like my previous post which has no restriction, free style parallel solution, W=A/H offset solution, scale A'=A x S² checking bug... 1.not for lines, convert+join+ purge vertices 2.single line N/A 3.not support bulged polyline or 3dpoly

;;;;;;;;;;;;;;;;;;;;;;;; CODE PROTECTION ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;; BY HANDASA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;protect your main lisp function "(PROTECTED-LISP)" by a serial number and a trail period ;upon calling "test" command this lisp will generate a code like this LICESNE: 141217654405-6310 ; consisting of date "141217" as DDMMYY and the NEXT 6 "654405" are the last 6 strings of "C" hard drive ID by calling (#Asmi_Get_Drive_Serial "C:") ;the 4 strings "6310" after the "-" string are code you use to generate a serial number for the user where serial = (63 - factor1)*(10 - factor1) * factor2 ;assuming factor1 is 4 and factor2 is 50 then the activation code for this user will be (63 - 4)*(10 - 4) * 50 = 17700 ; this serial is unique for this computer and will expire after the trail period and/or if windows reinstalled ; you can change your own factors 4 as you like which is factor1 variable in the lisp ;;;; hint: don't use values more than 10 ; you can change your own factors 50 as you like which is factor2 variable in the lisp ; you can change your own trial period which is ndays variable in the lisp code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun PROTECTED-LISP ( ) (alert (strcat "HELLO YOU ARE NOW HAVE FULL ACCESS TO THE PROGRAM FOR " (rtos ndays 2 0) " DAYS")) ;;;;;;;;;;;;;;;;; ;<YOUR CODE HERE> ;;;;;;;;;;;;;;;;; ) (DEFUN C:test ( / D1 D2 FACTOR1 FACTOR2 FIRST INPUTVALUE LOCK LOCK2 LOCK3 PCID) (setq ndays 30) ;;; define trail period days (setq factor1 4);;; define factor1 (setq factor2 50);;; define factor1 (if (not (GETENVX "INSTALLED")) ;FIRST RUN SETTING (progn (SETENVX "INSTALLED" "1") (alert "This Program Created By Eng.Mustapha Abdel Baset \n Please Like ,Subscribe And Share If You Like My work \n For contact Email me \n <Eng.Mustafa1288@gmail.com>") (getlock) (SETENVX "EXPIRED" 1) ;;; remove or comment this line to enable trail for n-days );progn ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;IF LISP IS REGISTERED TO PC (if (not (GETENVX "EXPIRED")) (progn (setq lock (GETENVX "LOCK_TOFF")) (setq d1 (menucmd "M=$(edtime,$(getvar,date),DD/MO/YY)")) (setq d2 (substr lock 1 ) (if (< (comparex d1 d2) -5) (alert "DATE AND TIME WERE CHANGED")) (if (or (> (comparex d1 d2) ndays)(< (comparex d1 d2) -5)) (progn (alert "expired") (SETENVX "EXPIRED" 1) (getlock) ) ;(alert "valid") (PROTECTED-LISP) ;;; main function here ) ) ) (if (GETENVX "EXPIRED") (progn (if (not (GETENVX "CODE")) (progn (setq d1 (menucmd "M=$(edtime,$(getvar,date),DD/MO/YY)")) (setq lock (GETENVX "LOCK_TOFF")) (setq lock2 (substr lock 9 20)) (setq lock3 (* (- (read (substr lock2 1 2)) factor1)(- (read (substr lock2 3 factor1)) 4) factor2) ) (setq pcid (rtos (#Asmi_Get_Drive_Serial "C:") 2 0)) (setq pcid (substr pcid (max 1 (- (strlen pcid) 5)) 20)) (setq first (vl-string-subst "" "/" (vl-string-subst "" "/" d1))) (SETENVX "LOCK3" (rtos (+ (* lock3 13) 1300) 2 0)) (SETENVX "CODE" (strcat "LICESNE: " first pcid "-" lock2)) ) ) (alert (strcat (GETENVX "CODE") "\n contact me to get your new activation code \n <Eng.Mustafa1288@gmail.com>")) (inputbox (GETENVX "CODE") "LISP EXPIRED" "") (if (and inputvalue (or (= (strcase inputvalue) "MUX")(= (read inputvalue) (/ (- (read (GETENVX "LOCK3")) 1300) 13)))) (progn (delenvx "EXPIRED") (delenvx "CODE") (getlock) (alert "LISP REGISTERED") ;;; main function here (PROTECTED-LISP) ) (progn (alert "NOT VALID KEY")) ) ) ) );DEFUN (defun delenvx (var) (vl-registry-delete "HKEY_CURRENT_USER\\TAKEOFF" var) ) (defun setenvx (var val) (vl-registry-write "HKEY_CURRENT_USER\\TAKEOFF" var val) ) (defun Getenvx (var) (vl-registry-read "HKEY_CURRENT_USER\\TAKEOFF" var) ) (defun comparex (d1 d2 / ALLDAYS DAY1 DAY2 DAY3 MO1 MO2 MO3 YR1 YR2 YR3) (setq yr1 (read (substr d1 7 2)) ;extract the year mo1 (read (substr d1 4 2)) ;extract the month day1 (read (substr d1 1 2)) ;extract the day );setq (setq yr2 (read (substr d2 7 2)) ;extract the year mo2 (read (substr d2 4 2)) ;extract the month day2 (read (substr d2 1 2)) ;extract the day );setq (if (> day1 day2) (setq day3 (- day1 day2)) (progn (setq day1 (+ day1 30)) (setq mo1 (- mo1 1)) (setq day3 (- day1 day2)) ) ) (if (> mo1 mo2) (setq mo3 (- mo1 mo2)) (progn (setq mo1 (+ mo1 12)) (setq yr1 (- yr1 1)) (setq mo3 (- mo1 mo2)) ) ) (setq yr3 (- yr1 yr2)) (setq alldays (+ (* yr3 365) (* mo3 30) day3)) );defun (defun rnd (/ modulus multiplier increment random) (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) random (/ seed modulus) ) ) (defun getlock () (setq rand "123") (while (or (not (equal 4 (strlen rand))) (not (read (substr rand 3 2)))(< (read (substr rand 3 2)) (1+ factor1))) (setq rand (rtos (fix(* 10000 (rnd))) 2 0)) ) (SETENVX "LOCK_TOFF" (strcat (menucmd "M=$(edtime,$(getvar,date),DD/MO/YY)") rand)) ) ;;; **** PC Hardware Functions ****** ;;; ********************************* ;;; * ;;; Retrieves Hard Drive serial number * ;;; * ;;; Arguments: * ;;; Path - Path of Hard Drive, for example "C:" (string) * ;;; * ;;; Output: * ;;; Hard Drive serial number (integer) or NIL in case of error. * ;;; * (defun #Asmi_Get_Drive_Serial(Path / fsObj hSn abPth cDrv) (vl-load-com) (if (and (setq fsObj(vlax-create-object "Scripting.FileSystemObject")) (not (vl-catch-all-error-p (setq abPth(vl-catch-all-apply 'vlax-invoke-method (list fsObj 'GetAbsolutePathName Path)) ); end setq ); end vl-catch-all-error-p ); end not ); end and (progn (setq cDrv(vlax-invoke-method fsObj 'GetDrive (vlax-invoke-method fsObj 'GetDriveName abPth ); end vlax-invoke-method );end vlax-invoke-method ); end setq (if (vl-catch-all-error-p (setq hSn(vl-catch-all-apply 'vlax-get-property (list cDrv 'SerialNumber)))) (progn (vlax-release-object cDrv) (setq hSn nil) ); end progn ); end if (vlax-release-object fsObj) ); end progn ); end if hSn ); end of #Asmi_Get_Drive_Serial ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun inputbox (prompt title default) (setq dcl_id (load_dialog "inputbox.dcl")) (if (not (new_dialog "inputbox" dcl_id)) (exit) ) (set_tile "prompt" prompt) (set_tile "title" title) (set_tile "eb1" default) (mode_tile "eb1" 2) (action_tile "cancel" "(done_dialog) (setq result nil)" ) (action_tile "accept" "(setq inputvalue (get_tile \"eb1\")) (done_dialog) (setq result T)" ) (start_dialog) (unload_dialog dcl_id) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;; end of coding ;;;;;;;;;;;;;;;;;;;;; (PRINC "\nTYPE 'TEST' TO RUN THE LISP")

like this... (wcmatch (cdr (assoc 1 entget_data_from_selection_1)) pp1) Well, all the steps I posted here are not tested, mainly seen from pure eye, but it should work (from my eyes at least)