Leaderboard
Popular Content
Showing content with the highest reputation on 05/09/2023 in all areas
-
like this? (haven't tested it because temp. out of acces to AutoCad so just pasted something together in notepad) ; independent simple dialog for getstring so no switching needed from dialog to command line (_ask "How are you?") (defun _ask ( $m / f p d r s) (if (and (setq f (vl-filename-mktemp ".dcl"))(setq p (open f "w"))) (progn (write-line (strcat "ask :dialog {label =\"" $m "\";:edit_box {key=\"eb\";}spacer;ok_cancel;}") p)(close p)(gc) (setq d (load_dialog f))(new_dialog "ask" d) (mapcar '(lambda(x y)(action_tile x y)) '("eb" "accept" "cancel") '("(chk_val $value)""(done_dialog 1)""(done_dialog 0)"))(setq r (start_dialog))(unload_dialog d)(vl-file-delete f))) (if (and (= r 1) (= 'STR (type s)) (/= s "")) s nil) ) (defun chk_val (v) (if (and (not (null v))(eq (type v) 'STR)(not (eq v ""))) ;;; if part of larger dialog write back to edit box ;;; (set_tile "eb" (setq s (strcat (vl-string-trim "\"" v) "\""))) ;;; else just return value (setq s (strcat (vl-string-trim "\"" v) "\"")) ) ) (defun c:t1 ( / r ) (if (setq r (_ask "how many inches ?"))(alert (strcat "result = " r))) (princ) )2 points
-
Worked really fine. My intention is click under a line like Kerbline and change me to Kerbline_LVL and start to create a Point Levels. The lisp routine to create point levels is working fine, but I was stalling on the part of switching to the previous layer. Thank you very much Steven!!1 point
-
Try this: (Noting the code tags are the <> button above) (defun c:PrevLay ( / MyLayers MySS MyEnt Lay-Name) ;;Local variables defined, initially nil when LISP runs ;;Sub function that can get the liosty of layers ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-list-of-all-layers-in-lisp/td-p/822262 (defun Table (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ; end while r ; return r ) ; end defun (setq MyLayers (acad_strlsort (Table "layer")) ) ; use sub function above and get a sorted list of layers (setq MySS (ssget "_+.:E:S" '((-4 . "<OR") (0 . "*LINE")(0 . "ARC")(0 . "ELLIPSE")(0 . "CIRCLE") (-4 . "OR>"))) ) ;select an item, filtered list (if (= (sslength MySS) 1) ; If a valid object was selected (progn (setq MyEnt (ssname MySS 0)) ; get entity name (setq Lay-Name (cdr (assoc 8 (entget MyEnt)))) ; get entity layer (setq Lay-Name_Pos (vl-position Lay-Name MyLayers)) ; find layer position in layers list (if (= Lay-Name_Pos 0) (setq New_Lay_Pos 0) ; if layer is the 1st in the lsit, do nothing (setq New_Lay_Pos (- Lay-Name_Pos 1)) ; go up 1 layer aphabetically ) ; end if ) ; end progn ) ; end if (command "_.-LAYER" "_SET" (nth New_Lay_Pos MyLayers) "") ; make active layer )1 point
-
LISP is correct in both cases: boundary is LWPOLYLINE or LINE (defun DXF (code en) (cdr (assoc code (entget en)))) ;;;========================================================================= (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Ray (po V) (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 po) (cons 11 v) ) ) ) ;;;========================================================================= (defun sysvar-set (lst_setvar / strN var var_oldname n) (setq n 0 lstvar_thiep nil lstValue_thiep nil ) (repeat (/ (length lst_setvar) 2) (setq var (nth n lst_setvar) var_oldname (strcat "oldvar_thiep" (itoa n)) ) (setq lstvar_thiep (append lstvar_thiep (list var))) (set (read var_oldname) (getvar var)) (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname)))) (setvar var (nth (+ n 1) lst_setvar)) (setq n (+ 2 n)) ) ) (defun Get-Area (lst ) (/ (apply '+ (mapcar '(lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) lst (cons (last lst) lst) ) ) 2 ) ) ;;;========================================================================= (defun SYSVAR-RESTORE () (mapcar '(lambda (var value) (setvar var (eval value))) lstvar_thiep lstValue_thiep ) ) ;;;========================================================================= (defun CalcZ (Pt1 Pt2 Pt3 / v w) (setq v (mapcar '- Pt1 Pt2) w (mapcar '- Pt3 Pt2) ) (- (* (car v) (cadr w)) (* (cadr v) (car w))) ) ;;;========================================================================= (defun calcThiep (po1 po2 po3 po4 / bit dis m anpha beta h obj_top poS poE) (setq anpha_org (LM:GetInsideAngle po4 po1 po2) beta_org (LM:GetInsideAngle po1 po2 po3) ) (if (< dt 0) (setq anpha anpha_org beta beta_org ) (setq anpha (- pi anpha_org) beta (- pi beta_org) ) ) (Setq bit (CalcZ po1 po4 po2)) (setq dis (distance po1 po2) ang (angle po1 po2) ) (setq m (+ (/ (cos anpha) (sin anpha)) (/ (cos beta) (sin beta)))) (setq h (abs (/ (- dis (sqrt (abs (- (* dis dis) (* 2 m (abs dt)))))) m))) (cond ((or (and (> bit 0) (> dt 0)) (and (< bit 0) (< dt 0))) (setq po5 (polar po2 (- ang (/ pi 2)) h) po6 (polar po1 (- ang (/ pi 2)) h) ) ) ((or (and (> bit 0) (< dt 0)) (and (< bit 0) (> dt 0))) (setq po5 (polar po2 (+ ang (/ pi 2)) h) po6 (polar po1 (+ ang (/ pi 2)) h) ) ) ) (setq po_in1 (inters po5 po6 po1 po4 nil) po_in2 (inters po5 po6 po2 po3 nil) ) ) (defun makeLWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (defun limS (po1 po2 po3 po4 / objL1 objL2 objR iplist) (line po4 po1) (setq objL1 (vlax-ename->vla-object (entlast))) (line po3 po2) (setq objL2 (vlax-ename->vla-object (entlast))) (cond ((> dt 0) (setq iplist (vlax-safearray->list (vlax-variant-value (vla-intersectwith objL1 objL2 3)) ) ) (vla-delete objL1) (vla-delete objL2) (SETQ A (Get-Area (list po1 po2 iplist po1))) ) ((< dt 0) (ray po4 (mapcar '- po2 po1)) (setq objR (vlax-ename->vla-object (entlast))) (if (null (vlax-invoke objR 'IntersectWith objL2 acExtendNone)) (PROGN (setq iplist (vlax-invoke objR 'IntersectWith objL2 acExtendOtherEntity ) ) (SETQ A (Get-Area (list po1 po2 iplist po4 po1))) ) (PROGN (vla-delete objR) (ray po3 (mapcar '- po1 po2)) (setq objR (vlax-ename->vla-object (entlast))) (setq iplist (vlax-invoke objR 'IntersectWith objL1 acExtendOtherEntity ) ) (SETQ A (Get-Area (list po1 po2 po3 iplist po1))) ) ) (vla-delete objL1) (vla-delete objL2) (vla-delete objR) ) ) (abs A) ) ;;;========================================================================= (defun c:dht (/ ent1_lst ent1 ent2 ent3 po1 po2 po3 po4 ang1 ang2 ang3 dis m lstpo1 lstpo2 lstpo3 lstpo-int1 lstpo-int2 anpha beta pS1 pS2 pS3 pE1 pE2 pE3 h bit obj_top poS poE po_in1 po_in2 prom Alim ) (command "undo" "be") (sysvar-set '("cmdecho" 0 "osmode" 0)) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (setq dt nil) (acet-ui-status) (sysvar-restore) (command "undo" "en") (princ) ) (or dt (setq dt (getcfg "AppData/trapezoid/area")) (setq dt 1000)) (acet-ui-status (setq prom (acet-str-format "\nEnter Area given for to expand (+S) or to trim (-S) <%1> : " (if (numberp dt) (rtos dt 2 3) dt ) "LOOK AT" ) ) ) (setq olddt dt) (setq dt (getreal prom)) (if (null dt) (setq dt olddt) ) (if (not (numberp dt)) (setq dt (atof dt)) ) (acet-ui-status (setq prom "\nPick a LINE (or LWPOLYLINE) edge for to expand (or to trim) area " ) "LOOK AT" ) (while (OR (NOT (setq ent1_lst (entsel prom))) (NOT (wcmatch (DXF 0 (setq ent1 (car ent1_lst))) "LINE,LWPOLYLINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status) (cond ((eq (DXF 0 ent1) "LINE") (acet-ui-status (setq prom "\nPick a LINE 1st edge of the trapezoid ") "LOOK AT" ) (while (OR (NOT (setq ent2 (car (entsel prom)))) (NOT (wcmatch (DXF 0 ent2) "LINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status (setq prom "\nPick a LINE 2nd edge of the trapezoid ") "LOOK AT" ) (while (OR (NOT (setq ent3 (car (entsel prom)))) (NOT (wcmatch (DXF 0 ent3) "LINE")) ) (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT" ) (prompt prom) ) (acet-ui-status) (setq po1 (vlax-curve-getStartpoint ent1) ;_bottom edge po2 (vlax-curve-getEndpoint ent1) ) (setq pS2 (vlax-curve-getStartpoint ent2) ;_ 1st side pE2 (vlax-curve-getEndpoint ent2) ) (setq pS3 (vlax-curve-getStartpoint ent3) ;_ 2nd side pE3 (vlax-curve-getEndpoint ent3) ) (cond ((Equal po1 ps3 1e-2) (setq po4 pE3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 pE3 1e-2) (setq po4 pS3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 ps2 1e-2) (setq po4 pE2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ((Equal po1 pE2 1e-2) (setq po4 pS2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ) ) ((eq (DXF 0 ent1) "LWPOLYLINE") (setq po_pick (cadr ent1_lst)) (setq po_closest (vlax-curve-getClosestPointTo ent1 po_pick)) (setq para1 (fix (vlax-curve-getParamatpoint ent1 po_closest))) (setq paraE (vlax-curve-getEndParam ent1)) (setq paraS (vlax-curve-getStartParam ent1)) (setq po1 (vlax-curve-getPointAtParam ent1 para1)) (cond ((= para1 0) (setq po4 (vlax-curve-getPointAtParam ent1 paraE) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) (if (equal po1 po4 1e-3) (setq po4 (vlax-curve-getPointAtParam ent1 (- paraE 1))) ) ) ((< (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) ) ((= (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 paraS) ) (if (equal po2 po3 1e-3) (setq po3 (vlax-curve-getPointAtParam ent1 (+ paraS 1))) ) ) ) ) ) (setq Alim (limS po1 po2 po3 po4)) (calcThiep po1 po2 po3 po4) (setvar "cecolor" "1") (makeLWPoly (list po1 po2 po_in2 po_in1 po1)) (setvar "cecolor" "256") (if (> (abs dt) Alim) (cond ((> (+ anpha_org beta_org) pi) (alert (acet-str-format "area to expand is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ((< (+ anpha_org beta_org) pi) (alert (acet-str-format "area to trim is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ) ) (setcfg "AppData/trapezoid/area" (rtos dt 2 3)) (SYSVAR-RESTORE) (command "undo" "en") (princ "ok") (princ) ) (defun LM:GetInsideAngle ( p1 p2 p3 ) ( (lambda ( a ) (min a (- (+ pi pi) a))) (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)) ) ) Extend_Trim_Area(DHT).lsp1 point
-
1 point