Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/07/2021 in all areas

  1. You're welcome! Since you're only taking action if 'arh' is greater than zero in string format*, the above could be written as: (if (< "0" arh) (command "_.extrude" "_all" "" arh)) *Consider either converting the value to an integer or using the not equal operator '/=' since, whilst it is possible to compare strings in this manner, the strings will be compared on a character-by-character basis comparing the ASCII code for each character, which may not yield an expected result - e.g. (< "10" "2") would return True.
    1 point
  2. Put your north arrows in model space then you don't have to worry about the angle.
    1 point
  3. Would you settle for R13 for Windows?
    1 point
  4. Here's a quick (untested) adaption of your code to integrate a call to my LM:listbox function: (defun c:formatxr ( / cmd def lst ) (while (setq def (tblnext "block" (not def))) (if (= 4 (logand 4 (cdr (assoc 70 def)))) (setq lst (cons (cdr (assoc 2 def)) lst)) ) ) (if lst (progn (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0) (foreach xrf (LM:listbox "Select Xrefs to Format" (acad_strlsort lst) 1) (command "_.-layer" "_color" 252 (strcat xrf "|*") "_pstyle" "Shade 50%" (strcat xrf "|*") "_color" 150 (strcat xrf "|C-PVMT-ASPH," xrf "|C-PVMT-CONC," xrf "|C-PVMT-GRVL") "_freeze" (strcat xrf "|X-TOPO-TEXT") "" ) ) (setvar 'cmdecho cmd) ) (princ "\nNo xrefs are defined in the active drawing.") ) (princ) )
    1 point
  5. Hi @BIGAL Your Lisp working well. According @Ish requirement is here (defun c:dd (/ sss obj ang ss vpo) (command "._PSPACE") (prompt "\nSelect source Viewport") (setq sss (ssget "_+.:E:S" (list (cons 0 "Viewport")) )) (setq obj (vlax-ename->vla-object (ssname sss 0))) (if (= (vla-get-objectname obj) "AcDbViewport") (setq ang (vlax-get obj 'TwistAngle)) ) (prompt "\nSelect North symbol Vewport") (setq ss (ssget "_+.:E:S" (list (cons 0 "Viewport")))) (setq vpo (vlax-ename->vla-object (ssname ss 0))) (vlax-put-property vpo 'TwistAngle ang) ) Original Result TwistAngle on Viewport.lsp
    1 point
  6. Give this a shot and let me knw. (defun c:Test ( / i s e g p q l r m d) ;; Tharwat - Date: 25.Mar.2021 ;; (and (princ "\nSelect parallel line objects to replace with closed polylines : ") (setq i -1 s (ssget "_:L" '((0 . "LINE")))) (while (setq i (1+ i) e (ssname s i)) (setq g (entget e) p (cdr (assoc 10 g)) q (cdr (assoc 11 g)) l (cons (list (cdr (assoc -1 g)) (mapcar '(lambda (j k) (/ (+ j k) 2.)) p q) p q) l) ) ) (progn (foreach itm l (or (vl-position (car itm) d) (and (setq m (cadr itm)) (setq r (cadr (vl-sort l '(lambda (j k) (< (distance m (cadr j)) (distance m (cadr k))))))) (not (vl-position (car r) d)) (setq p (caddr itm)) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)) (mapcar (function (lambda (n) (cons 10 n))) (append (list p) (vl-sort (cddr r) '(lambda (j k) (< (distance p j) (distance p k)))) (list (cadddr itm)) ) ) ) ) (setq d (cons (car itm) d) d (cons (car r) d) ) ) ) ) (mapcar 'entdel d) ) ) (princ) ) (vl-load-com)
    1 point
  7. version 2 ; Join end of 2 multiple lines convert to pline ; By Alan H March 2021 (defun c:joinends ( / pt1 pt2 start end swapends) (defun ah:swapends (pt / temp d1 d2 ent) (setq ent (entget (ssname (ssget pt)0 ))) (setq lay (cdr (assoc 8 ent))) (setq end (cdr (assoc 11 ent))) (setq start (cdr (assoc 10 ent))) (setq d1 (distance pt end)) (setq d2 (distance pt start)) (if (< d1 d2) (progn (setq temp end) (setq end start) (setq start temp) ) ) (command "erase" (cdr (assoc -1 ent)) "") (princ) ) (setq oldsnap (getvar 'osmode)) (prompt "\nPick points eg left and right of lines") (setq pt1 (getpoint "\Pick 1st point ")) (setq pt2 (getpoint pt1 "\Pick 2nd point ")) (setq lst (list pt1 pt2)) (setq ss (ssget "F" lst (list (cons 0 "*line")))) (setq lay (cdr (assoc 8 (entget (ssname ss 0))))) (setq lst2 '()) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq obj (vlax-ename->vla-object ent)) (setq pt3 (vlax-curve-getclosestpointto obj pt1)) (setq dist (distance pt1 pt3)) (setq lst2 (cons (list dist pt3) lst2)) ) (setq lst2 (vl-sort lst2 '(lambda (x y) (< (car x)(car y))))) (setq lst '()) (setq x 0) (setvar 'osmode 0) (repeat (/ (sslength ss) 2) (setq lst '()) (setq pt3 (nth 1 (nth x lst2))) (ah:swapends pt3) (setq lst (cons (list (car start) (cadr start))lst)) (setq lst (cons (list (car end)(cadr end)) lst)) (setq pt4 (nth 1 (nth (+ x 1) lst2))) (ah:swapends pt4) (setq lst (cons (list (car end)(cadr end)) lst)) (setq lst (cons (list (car start) (cadr start))lst)) (setq x (+ x 2)) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 lay) (cons 90 (length lst)) (cons 70 1)) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (setvar 'osmode oldsnap) (princ) )
    1 point
  8. You should have given the credit to @VovKa who helped you with it. https://www.theswamp.org/index.php?topic=56623.msg603840#msg603840
    1 point
×
×
  • Create New...