Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/15/2023 in all areas

  1. I'm not sure I follow .. the code HERE does that already? Nevermind .. I see what you are saying... let me take a look. Try this version: (defun c:foo (/ a c d) ;; RJP » 2023-08-13 ;; Sets hatch background color in blocks to 'none' (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a)))) ) (vlax-for b (vla-get-blocks d) ;; This line will only process block definitions (if (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-for o b (cond ((and (vlax-write-enabled-p o) (wcmatch (vla-get-objectname o) "AcDbHatch")) (setq c (vla-get-backgroundcolor o)) (vla-put-EntityColor c -939524096) (vla-put-backgroundcolor o c) ) ) ) ) ) (foreach l a (vlax-put l 'lock -1)) (vla-regen d acallviewports) (princ) )
    2 points
  2. @devitg FWIW the code could be simplified like so using (REM ANGLE PI) (defun c:vhlines-rjp (/ *error* ang e i s sn ss) ;;; Tharwat 13. Dec. 2012 ;;; ;; RJP » 2023-08-15 (if (and (progn (initget "Vertical Horizontal Both") (setq kw (cond ((getkword "\n Specify one [Vertical/Horizontal/Both] <Both> :")) ("Both") ) ) ) (setq s (ssadd)) (setq ss (ssget "_X" (list '(0 . "LINE") (cons 410 (getvar 'ctab))))) ) (progn ;; RJP - moved check out of loop (setq kw (cadr (assoc kw '(("Vertical" (equal ang (* pi 0.5) 1e-8)) ("Horizontal" (equal ang 0. 1e-8)) ("Both" (or (equal ang (* pi 0.5) 1e-8) (equal ang 0. 1e-8))) ) ) ) ) (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) e (entget sn) ) ;; RJP mod to return 0 or (* pi 1.5) (setq ang (rem (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))) pi)) (and (eval kw) (ssadd sn s)) ) (sssetfirst nil s) ) ) (princ) ) (defun c:vhlines-rjp2 (/ *error* ang e i s sn ss) ;;; Tharwat 13. Dec. 2012 ;;; ;; RJP » 2023-08-15 ;; Returns all lines NOT vertical or horizontal (if (and (setq s (ssadd)) (setq ss (ssget "_X" (list '(0 . "LINE") (cons 410 (getvar 'ctab)))))) (progn (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) e (entget sn) ) (setq ang (rem (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))) pi)) (or (or (equal ang (* pi 0.5) 1e-8) (equal ang 0. 1e-8)) (ssadd sn s)) ) (sssetfirst nil s) ) ) (princ) )
    1 point
  3. I'll look at this another time when I have word or something - the tabs in the file make reading the code quite tricky!
    1 point
  4. I use something like this for radio buttons: (action_tile "Radio_Name" "(setq A_Variable 0)(setq Another_Variable (A_Function))") For check boxes something like: (action_tile "Check_Box_Name" "(if (= (get_tile \"Check_Box_Name\") \"1\") (setq A_Variable 1) (setq A_Variable 0) )") Remembering to set for both states I think Then later in the code check the value of the variables to do what you want
    1 point
  5. Simple with the inters command: http://docs.autodesk.com/ACD/2013/PTB/index.html?url=files/GUID-A181D474-F817-4550-86E9-87649262FA8A.htm,topicNumber=d30e610867 Bit more complex: Vla-intrsectwith A bit better with Lee Macs Intersection functions: http://lee-mac.com/intersectionfunctions.html
    1 point
  6. You need to go back to 1st principles of geometry for red rectangs, I would work out right hand point on purple line, then a little tricky but work out point on white line. You have a couple of knowns like the distance of short red perp line. so using geometry can work out the 4 points. Then use a wipeout much easier than trimming around the rectang. Think Pythagoras or sine theory.
    1 point
  7. I originally went through the Garden Path Tutorial years ago. Maybe read through the Reactor section, doesn't seem much different than what you want. You might look into Polyline-Bulge instead of Fillet. And more at Polyline Bulges - Part 1 | AfraLISP
    1 point
×
×
  • Create New...